[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 3effa2d 3/3: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 3effa2d 3/3: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Mon, 13 Apr 2020 05:57:31 -0400 (EDT) |
branch: feature/native-comp
commit 3effa2d674691b069cefd978187100911296f738
Merge: c8b7e07 c395eba
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Merge remote-tracking branch 'savannah/master' into HEAD
---
etc/NEWS | 9 +++-
lisp/files.el | 2 +
lisp/hi-lock.el | 37 ++++++++--------
lisp/mail/rmail.el | 14 ++++++-
lisp/subr.el | 2 +
src/callproc.c | 12 +++++-
test/lisp/hi-lock-tests.el | 102 ++++++++++++++++++++++++++++++++++++++++++++-
test/src/callproc-tests.el | 17 ++++++++
8 files changed, 171 insertions(+), 24 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 28c01d7..9f3e5b6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -267,7 +267,7 @@ to substitute spaces in regexp search.
---
*** The default value of 'hi-lock-highlight-range' was enlarged.
-The new default value is 2000000 (2 million).
+The new default value is 2000000 (2 megabytes).
** Texinfo
@@ -275,6 +275,13 @@ The new default value is 2000000 (2 million).
*** New customizable option 'texinfo-texi2dvi-options'.
This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'.
+** Rmail
+
+---
+*** New customizable option 'rmail-re-abbrevs'.
+Its default value matches localized abbreviations of the "reply"
+prefix on the Subject line in various languages.
+
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/files.el b/lisp/files.el
index beafdac..f49be4f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1094,6 +1094,8 @@ REMOTE is non-nil, search on the remote host indicated by
(let ((default-directory (file-name-quote default-directory 'top)))
(locate-file command exec-path exec-suffixes 1))))
+(declare-function read-library-name "find-func" nil)
+
(defun load-library (library)
"Load the Emacs Lisp library named LIBRARY.
LIBRARY should be a string.
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index d5e4665..1d8dc06 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -564,13 +564,15 @@ in which case the highlighting will not update as you
type."
(let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp)))
(when regexp (push regexp regexps)))
;; With font-locking on, check if the cursor is on a highlighted text.
- (let ((face-after (get-text-property (point) 'face))
- (face-before
- (unless (bobp) (get-text-property (1- (point)) 'face)))
- (faces (mapcar #'hi-lock-keyword->face
- hi-lock-interactive-patterns)))
- (unless (memq face-before faces) (setq face-before nil))
- (unless (memq face-after faces) (setq face-after nil))
+ (let* ((faces-after (get-text-property (point) 'face))
+ (faces-before
+ (unless (bobp) (get-text-property (1- (point)) 'face)))
+ (faces-after (if (consp faces-after) faces-after (list
faces-after)))
+ (faces-before (if (consp faces-before) faces-before (list
faces-before)))
+ (faces (mapcar #'hi-lock-keyword->face
+ hi-lock-interactive-patterns))
+ (face-after (seq-some (lambda (face) (car (memq face faces)))
faces-after))
+ (face-before (seq-some (lambda (face) (car (memq face faces)))
faces-before)))
(when (and face-before face-after (not (eq face-before face-after)))
(setq face-before nil))
(when (or face-after face-before)
@@ -588,7 +590,8 @@ in which case the highlighting will not update as you type."
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (car hi-lock-pattern)))
+ (let ((regexp (or (car (rassq hi-lock-pattern
hi-lock-interactive-lighters))
+ (car hi-lock-pattern))))
(if (string-match regexp hi-text)
(push regexp regexps)))))))
regexps))
@@ -642,15 +645,10 @@ then remove all hi-lock highlighting."
(user-error "No highlighting to remove"))
;; Infer the regexp to un-highlight based on cursor position.
(let* ((defaults (or (hi-lock--regexps-at-point)
- (mapcar #'car hi-lock-interactive-patterns))))
- (setq defaults
- (mapcar (lambda (default)
- (or (car (rassq default
- (mapcar (lambda (a)
- (cons (car a) (cadr a)))
- hi-lock-interactive-lighters)))
- default))
- defaults))
+ (mapcar (lambda (pattern)
+ (or (car (rassq pattern
hi-lock-interactive-lighters))
+ (car pattern)))
+ hi-lock-interactive-patterns))))
(list
(completing-read (if (null defaults)
"Regexp to unhighlight: "
@@ -767,7 +765,8 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock
search."
(list subexp (list 'quote face) 'prepend)))
(no-matches t))
;; Refuse to highlight a text that is already highlighted.
- (if (assoc regexp hi-lock-interactive-patterns)
+ (if (or (assoc regexp hi-lock-interactive-patterns)
+ (assoc (or lighter regexp) hi-lock-interactive-lighters))
(add-to-list 'hi-lock--unused-faces (face-name face))
(push pattern hi-lock-interactive-patterns)
(push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters)
@@ -792,7 +791,7 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock
search."
(let ((overlay (make-overlay (match-beginning subexp)
(match-end subexp))))
(overlay-put overlay 'hi-lock-overlay t)
- (overlay-put overlay 'hi-lock-overlay-regexp regexp)
+ (overlay-put overlay 'hi-lock-overlay-regexp (or lighter
regexp))
(overlay-put overlay 'face face))
(goto-char (match-end 0)))
(when no-matches
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index d79cea9..40d3470 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -578,11 +578,21 @@ Examples:
(defvar rmail-reply-prefix "Re: "
"String to prepend to Subject line when replying to a message.")
+;; Note: this is matched with case-fold-search bound to t.
+(defcustom rmail-re-abbrevs
+
"\\(RE\\|رد\\|回复\\|回覆\\|SV\\|Antw\\|VS\\|REF\\|AW\\|ΑΠ\\|ΣΧΕΤ\\|השב\\|Vá\\|R\\|RIF\\|BLS\\|RES\\|Odp\\|YNT\\|ATB\\)"
+ "Regexp with localized 'Re:' abbreviations in various languages."
+ :version "28.1"
+ :type 'regexp)
+
;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
;; This pattern should catch all the common variants.
;; rms: I deleted the change to delete tags in square brackets
;; because they mess up RT tags.
-(defvar rmail-reply-regexp
"\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
+(defvar rmail-reply-regexp
+ (concat "\\`\\("
+ rmail-re-abbrevs
+ "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?[:：] *\\)*")
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
(defcustom rmail-display-summary nil
@@ -3398,7 +3408,7 @@ whitespace, replacing whitespace runs with a single space
and
removing prefixes such as Re:, Fwd: and so on and mailing list
tags such as [tag]."
(let ((subject (or (rmail-get-header "Subject" msgnum) ""))
- (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,3\\}:\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
+ (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}[:：]\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
(setq subject (rfc2047-decode-string subject))
(setq subject (replace-regexp-in-string regexp "" subject))
(replace-regexp-in-string "[ \t\n]+" " " subject)))
diff --git a/lisp/subr.el b/lisp/subr.el
index 70a74fb..f7445d8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2285,6 +2285,8 @@ Otherwise TYPE is assumed to be a symbol property."
(not (eq 'require (car match)))))))
(throw 'found file))))))
+(declare-function read-library-name "find-func" nil)
+
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
LIBRARY should be a relative file name of the library, a string.
diff --git a/src/callproc.c b/src/callproc.c
index 8883415..65c8583 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -1099,7 +1099,17 @@ usage: (call-process-region START END PROGRAM &optional
DELETE BUFFER DISPLAY &r
}
if (nargs > 3 && !NILP (args[3]))
- Fdelete_region (start, end);
+ {
+ if (NILP (start))
+ {
+ /* No need to save restrictions since we delete everything
+ anyway. */
+ Fwiden ();
+ del_range (BEG, Z);
+ }
+ else
+ Fdelete_region (start, end);
+ }
if (nargs > 3)
{
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index dd2c280..252caaa 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -33,7 +33,9 @@
(car defaults))))
(dotimes (_ 2)
(let ((face (hi-lock-read-face-name)))
- (hi-lock-set-pattern "a" face))))
+ ;; This test should use regexp "b" different from "a"
+ ;; used in another test because hi-lock--hashcons is global.
+ (hi-lock-set-pattern "b" face))))
(should (equal hi-lock--unused-faces (cdr faces))))))
(ert-deftest hi-lock-test-set-pattern ()
@@ -48,5 +50,103 @@
;; Only one match, then we have used just 1 face
(should (equal hi-lock--unused-faces (cdr faces))))))
+(ert-deftest hi-lock-case-fold ()
+ "Test for case-sensitivity."
+ (let ((hi-lock-auto-select-face t))
+ (with-temp-buffer
+ (insert "a A b B\n")
+
+ (dotimes (_ 2) (highlight-regexp "[a]"))
+ (should (= (length (overlays-in (point-min) (point-max))) 2))
+ (unhighlight-regexp "[a]")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-regexp "[a]" nil nil "a"))
+ (should (= (length (overlays-in (point-min) (point-max))) 2))
+ (unhighlight-regexp "a")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" ))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "[A]")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" nil nil "A"))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "A")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (let ((case-fold-search nil)) (dotimes (_ 2) (highlight-regexp "[a]")))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "[a]")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (dotimes (_ 2) (highlight-phrase "a a"))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (unhighlight-regexp "a a")
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp
"a a"))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll _x _y _z _hist defaults)
+ (car defaults))))
+ (call-interactively 'unhighlight-regexp))
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (emacs-lisp-mode)
+ (setq font-lock-mode t)
+
+ (dotimes (_ 2) (highlight-regexp "[a]"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "[a]"))
+ (should (null (get-text-property 3 'face)))
+
+ (dotimes (_ 2) (highlight-regexp "[a]" nil nil "a"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "a"))
+ (should (null (get-text-property 3 'face)))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" ))
+ (font-lock-ensure)
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "[A]"))
+ (should (null (get-text-property 3 'face)))
+
+ (dotimes (_ 2) (highlight-regexp "[A]" nil nil "A"))
+ (font-lock-ensure)
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "A"))
+ (should (null (get-text-property 3 'face)))
+
+ (let ((case-fold-search nil)) (dotimes (_ 2) (highlight-regexp "[a]")))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (null (get-text-property 3 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "[a]"))
+ (should (null (get-text-property 1 'face)))
+
+ (dotimes (_ 2) (highlight-phrase "a a"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (let ((font-lock-fontified t)) (unhighlight-regexp "a a"))
+ (should (null (get-text-property 1 'face)))
+
+ (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp
"a a"))
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll _x _y _z _hist defaults)
+ (car defaults)))
+ (font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 1 'face))))))
+
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here
diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el
index 39d2014..1617d5e 100644
--- a/test/src/callproc-tests.el
+++ b/test/src/callproc-tests.el
@@ -17,6 +17,11 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Unit tests for src/callproc.c.
+
;;; Code:
(require 'ert)
@@ -60,3 +65,15 @@
(call-process "c:/nul.exe")
(error :got-error))))
(should have-called-debugger)))
+
+(ert-deftest call-process-region-entire-buffer-with-delete ()
+ "Check that Bug#40576 is fixed."
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (insert "Buffer contents\n")
+ (should
+ (eq (call-process-region nil nil emacs :delete nil nil "--version") 0))
+ (should (eq (buffer-size) 0)))))
+
+;;; callproc-tests.el ends here