[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1e0632e 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/g
|
From: |
Eli Zaretskii |
|
Subject: |
master 1e0632e 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs |
|
Date: |
Sat, 6 Feb 2021 08:11:27 -0500 (EST) |
branch: master
commit 1e0632e772f43ba7fd2aca180ee041bf3571d43f
Merge: f534d3f 5903db0
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
---
lisp/auth-source.el | 77 +++++++++++++++++++++-----------------------
lisp/emacs-lisp/generator.el | 21 ++++++------
lisp/emacs-lisp/testcover.el | 60 +++++++++++++++++-----------------
lisp/gnus/message.el | 4 +++
lisp/gnus/mml-sec.el | 15 +++++----
lisp/net/mailcap.el | 10 +++---
lisp/subr.el | 6 +++-
7 files changed, 102 insertions(+), 91 deletions(-)
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 2494040..14cae8a 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -581,14 +581,15 @@ default value. If the user, host, or port are missing,
the alist
`auth-source-creation-prompts' will be used to look up the
prompts IN THAT ORDER (so the `user' prompt will be queried first,
then `host', then `port', and finally `secret'). Each prompt string
-can use %u, %h, and %p to show the user, host, and port.
+can use %u, %h, and %p to show the user, host, and port. The prompt
+is formatted with `format-prompt', a trailing \": \" is removed.
Here's an example:
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
- \\='((secret . \"Enter IMAP password for %h:%p: \"))))
+ \\='((secret . \"Enter IMAP password for %h:%p\"))))
(auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc
:max 1
:P \"pppp\" :Q \"qqqq\"
:create \\='(A B Q)))
@@ -860,7 +861,9 @@ while \(:host t) would find all host entries."
secret)))
(defun auth-source-format-prompt (prompt alist)
- "Format PROMPT using %x (for any character x) specifiers in ALIST."
+ "Format PROMPT using %x (for any character x) specifiers in ALIST.
+Remove trailing \": \"."
+ (setq prompt (replace-regexp-in-string ":\\s-*$" "" prompt))
(dolist (cell alist)
(let ((c (nth 0 cell))
(v (nth 1 cell)))
@@ -1344,11 +1347,11 @@ See `auth-source-search' for details on SPEC."
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
- (secret "%p password for %u@%h: ")
- (user "%p user name for %h: ")
- (host "%p host name for user %u: ")
- (port "%p port for %u@%h: "))
- (format "Enter %s (%%u@%%h:%%p): " r)))
+ (secret "%p password for %u@%h")
+ (user "%p user name for %h")
+ (host "%p host name for user %u")
+ (port "%p port for %u@%h"))
+ (format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@@ -1378,7 +1381,9 @@ See `auth-source-search' for details on SPEC."
(setq check nil)))
ret))
(t 'never)))
- (plain (or (eval default) (read-passwd
prompt))))
+ (plain
+ (or (eval default)
+ (read-passwd (format-prompt prompt
nil)))))
;; ask if we don't know what to do (in which case
;; auth-source-netrc-use-gpg-tokens must be a
list)
(unless gpg-encrypt
@@ -1390,12 +1395,9 @@ See `auth-source-search' for details on SPEC."
(if (eq gpg-encrypt 'gpg)
(auth-source-epa-make-gpg-token plain file)
plain))
- (if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0
(match-beginning 0))
- " (default " default "):
")
- (concat prompt "(default " default
") "))
- nil nil default)
+ (if (and (stringp default) auth-source-save-behavior)
+ (read-string
+ (format-prompt prompt default) nil nil default)
(eval default)))))
(when data
@@ -1745,12 +1747,12 @@ authentication tokens:
"[any label]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
- (secret "%p password for %u@%h: ")
- (user "%p user name for %h: ")
- (host "%p host name for user %u: ")
- (port "%p port for %u@%h: ")
- (label "Enter label for %u@%h: "))
- (format "Enter %s (%%u@%%h:%%p): " r)))
+ (secret "%p password for %u@%h")
+ (user "%p user name for %h")
+ (host "%p host name for user %u")
+ (port "%p port for %u@%h")
+ (label "Enter label for %u@%h"))
+ (format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@@ -1760,13 +1762,11 @@ authentication tokens:
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
- (or (eval default) (read-passwd prompt))
- (if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0
(match-beginning 0))
- " (default " default "):
")
- (concat prompt "(default " default
") "))
- nil nil default)
+ (or (eval default)
+ (read-passwd (format-prompt prompt nil)))
+ (if (and (stringp default) auth-source-save-behavior)
+ (read-string
+ (format-prompt prompt default) nil nil default)
(eval default)))))
(when data
@@ -2190,11 +2190,11 @@ entries for git.gnus.org:
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
- (secret "%p password for %u@%h: ")
- (user "%p user name for %h: ")
- (host "%p host name for user %u: ")
- (port "%p port for %u@%h: "))
- (format "Enter %s (%%u@%%h:%%p): " r)))
+ (secret "%p password for %u@%h")
+ (user "%p user name for %h")
+ (host "%p host name for user %u")
+ (port "%p port for %u@%h"))
+ (format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@@ -2204,14 +2204,11 @@ entries for git.gnus.org:
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
- (or (eval default) (read-passwd prompt))
- (if (stringp default)
+ (or (eval default)
+ (read-passwd (format-prompt prompt nil)))
+ (if (and (stringp default) auth-source-save-behavior)
(read-string
- (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0 (match-beginning
0))
- " (default " default "): ")
- (concat prompt "(default " default ") "))
- nil nil default)
+ (format-prompt prompt default) nil nil default)
(eval default)))))
(when data
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 9eb6d95..e45260c 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -725,17 +725,20 @@ Return the value with which ITERATOR finished iteration."
(condition-symbol (cps--gensym "iter-do-condition"))
(it-symbol (cps--gensym "iter-do-iterator"))
(result-symbol (cps--gensym "iter-do-result")))
- `(let (,var
- ,result-symbol
+ `(let (,result-symbol
(,done-symbol nil)
(,it-symbol ,iterator))
- (while (not ,done-symbol)
- (condition-case ,condition-symbol
- (setf ,var (iter-next ,it-symbol))
- (iter-end-of-sequence
- (setf ,result-symbol (cdr ,condition-symbol))
- (setf ,done-symbol t)))
- (unless ,done-symbol ,@body))
+ (while
+ (let ((,var
+ (condition-case ,condition-symbol
+ (iter-next ,it-symbol)
+ (iter-end-of-sequence
+ (setf ,result-symbol (cdr ,condition-symbol))
+ (setf ,done-symbol t)))))
+ (unless ,done-symbol
+ ,@body
+ ;; Loop until done-symbol is set.
+ t)))
,result-symbol)))
(defvar cl--loop-args)
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 312e387..50f2b51 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -258,10 +258,10 @@ vector. Return VALUE."
(aset testcover-vector after-index (testcover--copy-object value)))
((eq 'maybe old-result)
(aset testcover-vector after-index 'edebug-ok-coverage))
- ((eq '1value old-result)
+ ((eq 'testcover-1value old-result)
(aset testcover-vector after-index
(cons old-result (testcover--copy-object value))))
- ((and (eq (car-safe old-result) '1value)
+ ((and (eq (car-safe old-result) 'testcover-1value)
(not (condition-case ()
(equal (cdr old-result) value)
(circular-list t))))
@@ -358,11 +358,11 @@ eliminated by adding more test cases."
data (aref coverage len))
(when (and (not (eq data 'edebug-ok-coverage))
(not (memq (car-safe data)
- '(1value maybe noreturn)))
+ '(testcover-1value maybe noreturn)))
(setq j (+ def-mark (aref points len))))
(setq ov (make-overlay (1- j) j))
(overlay-put ov 'face
- (if (memq data '(edebug-unknown maybe 1value))
+ (if (memq data '(edebug-unknown maybe testcover-1value))
'testcover-nohits
'testcover-1value))))
(set-buffer-modified-p changed))))
@@ -450,12 +450,12 @@ or return multiple values."
(`(defconst ,sym . ,args)
(push sym testcover-module-constants)
(testcover-analyze-coverage-progn args)
- '1value)
+ 'testcover-1value)
(`(defun ,name ,_ . ,doc-and-body)
(let ((val (testcover-analyze-coverage-progn doc-and-body)))
(cl-case val
- ((1value) (push name testcover-module-1value-functions))
+ ((testcover-1value) (push name testcover-module-1value-functions))
((maybe) (push name testcover-module-potentially-1value-functions)))
nil))
@@ -466,13 +466,13 @@ or return multiple values."
;; To avoid infinite recursion, don't examine quoted objects.
;; This will cause the coverage marks on an instrumented quoted
;; form to look odd. See bug#25316.
- '1value)
+ 'testcover-1value)
(`(\` ,bq-form)
(testcover-analyze-coverage-backquote-form bq-form))
((or 't 'nil (pred keywordp))
- '1value)
+ 'testcover-1value)
((pred vectorp)
(testcover-analyze-coverage-compose (append form nil)
@@ -482,7 +482,7 @@ or return multiple values."
nil)
((pred atom)
- '1value)
+ 'testcover-1value)
(_
;; Whatever we have here, it's not wrapped, so treat it as a list of
forms.
@@ -494,7 +494,7 @@ Analyze all the forms in FORMS and return 1value, maybe or
nil
depending on the analysis of the last one. Find the coverage
vectors referenced by `edebug-enter' forms nested within FORMS and
update them with the results of the analysis."
- (let ((result '1value))
+ (let ((result 'testcover-1value))
(while (consp forms)
(setq result (testcover-analyze-coverage (pop forms))))
result))
@@ -516,9 +516,9 @@ form to be treated accordingly."
(aset testcover-vector before-id 'edebug-ok-coverage))
(setq val (testcover-analyze-coverage-wrapped-form wrapped-form))
- (when (or (eq wrapper '1value) val)
+ (when (or (eq wrapper 'testcover-1value) val)
;; The form is 1-valued or potentially 1-valued.
- (aset testcover-vector after-id (or val '1value)))
+ (aset testcover-vector after-id (or val 'testcover-1value)))
(cond
((or (eq wrapper 'noreturn)
@@ -526,13 +526,13 @@ form to be treated accordingly."
;; This function won't return, so indicate to testcover-before that
;; it should record coverage.
(aset testcover-vector before-id (cons 'noreturn after-id))
- (aset testcover-vector after-id '1value)
- (setq val '1value))
+ (aset testcover-vector after-id 'testcover-1value)
+ (setq val 'testcover-1value))
- ((eq (car-safe wrapped-form) '1value)
+ ((eq (car-safe wrapped-form) 'testcover-1value)
;; This function is always supposed to return the same value.
- (setq val '1value)
- (aset testcover-vector after-id '1value)))
+ (setq val 'testcover-1value)
+ (aset testcover-vector after-id 'testcover-1value)))
val))
(defun testcover-analyze-coverage-wrapped-form (form)
@@ -540,26 +540,26 @@ form to be treated accordingly."
FORM is treated as if it will be evaluated."
(pcase form
((pred keywordp)
- '1value)
+ 'testcover-1value)
((pred symbolp)
(when (or (memq form testcover-constants)
(memq form testcover-module-constants))
- '1value))
+ 'testcover-1value))
((pred atom)
- '1value)
+ 'testcover-1value)
(`(\` ,bq-form)
(testcover-analyze-coverage-backquote-form bq-form))
(`(defconst ,sym ,val . ,_)
(push sym testcover-module-constants)
(testcover-analyze-coverage val)
- '1value)
+ 'testcover-1value)
(`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body)
;; These always return RESULT if provided.
(testcover-analyze-coverage expr)
(testcover-analyze-coverage-progn body)
(let ((val (testcover-analyze-coverage-progn result)))
;; If the third value is not present, the loop always returns nil.
- (if result val '1value)))
+ (if result val 'testcover-1value)))
(`(,(or 'let 'let*) ,bindings . ,body)
(testcover-analyze-coverage-progn bindings)
(testcover-analyze-coverage-progn body))
@@ -586,9 +586,9 @@ FORM is treated as if it will be evaluated."
;; depending on the symbol.
(let ((temp-form (cons func args)))
(testcover-analyze-coverage-wrapped-form temp-form)))
- (`(,(and func (or '1value 'noreturn)) ,inner-form)
+ (`(,(and func (or 'testcover-1value 'noreturn)) ,inner-form)
;; 1value and noreturn change how the edebug-after they wrap is handled.
- (let ((val (if (eq func '1value) '1value 'maybe)))
+ (let ((val (if (eq func 'testcover-1value) 'testcover-1value 'maybe)))
(pcase inner-form
(`(edebug-after ,(and before-form
(or `(edebug-before ,before-id) before-id))
@@ -604,12 +604,12 @@ FORM is treated as if it will be evaluated."
(defun testcover-analyze-coverage-wrapped-application (func args)
"Analyze the application of FUNC to ARGS for code coverage."
(cond
- ((eq func 'quote) '1value)
+ ((eq func 'quote) 'testcover-1value)
((or (memq func testcover-1value-functions)
(memq func testcover-module-1value-functions))
;; The function should always return the same value.
(testcover-analyze-coverage-progn args)
- '1value)
+ 'testcover-1value)
((or (memq func testcover-potentially-1value-functions)
(memq func testcover-module-potentially-1value-functions))
;; The function might always return the same value.
@@ -635,14 +635,14 @@ If either argument is nil, return nil, otherwise if either
argument is maybe, return maybe. Return 1value only if both arguments
are 1value."
(cl-case val
- (1value result)
+ (testcover-1value result)
(maybe (and result 'maybe))
(nil nil)))
(defun testcover-analyze-coverage-compose (forms func)
"Analyze a list of FORMS for code coverage using FUNC.
The list is 1valued if all of its constituent elements are also 1valued."
- (let ((result '1value))
+ (let ((result 'testcover-1value))
(while (consp forms)
(setq result (testcover-coverage-combine result (funcall func (car
forms))))
(setq forms (cdr forms)))
@@ -652,7 +652,7 @@ The list is 1valued if all of its constituent elements are
also 1valued."
(defun testcover-analyze-coverage-backquote (bq-list)
"Analyze BQ-LIST, the body of a backquoted list, for code coverage."
- (let ((result '1value))
+ (let ((result 'testcover-1value))
(while (consp bq-list)
(let ((form (car bq-list))
val)
@@ -670,7 +670,7 @@ The list is 1valued if all of its constituent elements are
also 1valued."
"Analyze a single FORM from a backquoted list for code coverage."
(cond
((vectorp form) (testcover-analyze-coverage-backquote (append form nil)))
- ((atom form) '1value)
+ ((atom form) 'testcover-1value)
((memq (car form) (list '\, '\,@))
(testcover-analyze-coverage (cadr form)))
(t (testcover-analyze-coverage-backquote form))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 6668784..5a5dbce 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4315,6 +4315,10 @@ It should typically alter the sending method in some way
or other."
(when message-confirm-send
(or (y-or-n-p "Send message? ")
(keyboard-quit)))
+ (when (and (not (mml-secure-is-encrypted-p))
+ (mml-secure-is-encrypted-p 'anywhere)
+ (not (yes-or-no-p "This message has a <#secure tag, but is not
going to be encrypted. Send anyway?")))
+ (error "Aborting sending"))
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 8d01d15..d41c9dd 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -298,14 +298,17 @@ Use METHOD if given. Else use `mml-secure-method' or
(interactive)
(mml-secure-part "smime"))
-(defun mml-secure-is-encrypted-p ()
- "Check whether secure encrypt tag is present."
+(defun mml-secure-is-encrypted-p (&optional tag-present)
+ "Whether the current buffer contains a mail message that should be encrypted.
+If TAG-PRESENT, say whether the <#secure tag is present anywhere
+in the buffer."
(save-excursion
(goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"
- "<#secure[^>]+encrypt")
- nil t)))
+ (message-goto-body)
+ (if tag-present
+ (re-search-forward "<#secure[^>]+encrypt" nil t)
+ (skip-chars-forward "[ \t\n")
+ (looking-at "<#secure[^>]+encrypt"))))
(defun mml-secure-bcc-is-safe ()
"Check whether usage of Bcc is safe (or absent).
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 455673b..b95cd0f 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -842,11 +842,11 @@ If NO-DECODE is non-nil, don't decode STRING."
;; ~/.mailcap file, then we filter out the system entries
;; and see whether we have anything left.
(when mailcap-prefer-mailcap-viewers
- (when-let ((user-entry
- (seq-find (lambda (elem)
- (eq (cdr (assq 'source elem)) 'user))
- passed)))
- (setq passed (list user-entry))))
+ (when-let ((user-entries
+ (seq-filter (lambda (elem)
+ (eq (cdr (assq 'source elem)) 'user))
+ passed)))
+ (setq passed user-entries)))
(setq viewer (car passed))))
(when (and (stringp (cdr (assq 'viewer viewer)))
passed)
diff --git a/lisp/subr.el b/lisp/subr.el
index 6e52bd2..f0de6d5 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2228,9 +2228,13 @@ Affects only hooks run in the current buffer."
;; PUBLIC: find if the current mode derives from another.
(defun provided-mode-derived-p (mode &rest modes)
- "Non-nil if MODE is derived from one of MODES or their aliases.
+ "Non-nil if MODE is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards.
If you just want to check `major-mode', use `derived-mode-p'."
+ ;; If MODE is an alias, then look up the real mode function first.
+ (when-let ((alias (symbol-function mode)))
+ (when (symbolp alias)
+ (setq mode alias)))
(while
(and
(not (memq mode modes))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 1e0632e 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs,
Eli Zaretskii <=