aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorAndrea Corallo2021-01-16 13:26:10 +0100
committerAndrea Corallo2021-01-16 13:26:10 +0100
commit0a7ac0b5504e75275699a3d8d2d5d94bcfda8708 (patch)
treebb6158c8a9edeb1e716718abfc98dca16aef9e9e /lisp
parentf1efac1f9efbfa15b6434ebef507c00c1277633f (diff)
parent0732fc31932c75c682c8b65b4dcb4376ca63e8fd (diff)
downloademacs-0a7ac0b5504e75275699a3d8d2d5d94bcfda8708.tar.gz
emacs-0a7ac0b5504e75275699a3d8d2d5d94bcfda8708.zip
Merge remote-tracking branch 'savannah/master' into native-comp
Diffstat (limited to 'lisp')
-rw-r--r--lisp/calc/calc.el10
-rw-r--r--lisp/cedet/ede/auto.el24
-rw-r--r--lisp/comint.el26
-rw-r--r--lisp/cus-face.el1
-rw-r--r--lisp/cus-start.el6
-rw-r--r--lisp/custom.el13
-rw-r--r--lisp/dired-x.el2
-rw-r--r--lisp/emacs-lisp/cl-generic.el26
-rw-r--r--lisp/emacs-lisp/cl-macs.el123
-rw-r--r--lisp/emacs-lisp/eieio-base.el135
-rw-r--r--lisp/emacs-lisp/lisp-mode.el6
-rw-r--r--lisp/emacs-lisp/macroexp.el29
-rw-r--r--lisp/emacs-lisp/pcase.el27
-rw-r--r--lisp/emacs-lisp/shortdoc.el13
-rw-r--r--lisp/erc/erc-services.el56
-rw-r--r--lisp/foldout.el2
-rw-r--r--lisp/frame.el8
-rw-r--r--lisp/gnus/gnus-search.el11
-rw-r--r--lisp/gnus/gnus-win.el1
-rw-r--r--lisp/gnus/message.el12
-rw-r--r--lisp/gnus/mm-decode.el19
-rw-r--r--lisp/gnus/nnmaildir.el3
-rw-r--r--lisp/help-fns.el4
-rw-r--r--lisp/help-mode.el3
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/isearch.el61
-rw-r--r--lisp/minibuffer.el8
-rw-r--r--lisp/mouse-drag.el4
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/net/nsm.el2
-rw-r--r--lisp/net/tramp-adb.el6
-rw-r--r--lisp/net/tramp-sh.el162
-rw-r--r--lisp/net/tramp.el24
-rw-r--r--lisp/net/trampver.el6
-rw-r--r--lisp/pixel-scroll.el12
-rw-r--r--lisp/progmodes/flymake.el7
-rw-r--r--lisp/progmodes/project.el19
-rw-r--r--lisp/progmodes/prolog.el6
-rw-r--r--lisp/progmodes/python.el6
-rw-r--r--lisp/progmodes/xref.el15
-rw-r--r--lisp/ruler-mode.el4
-rw-r--r--lisp/shell.el1
-rw-r--r--lisp/simple.el34
-rw-r--r--lisp/startup.el37
-rw-r--r--lisp/strokes.el23
-rw-r--r--lisp/subr.el112
-rw-r--r--lisp/textmodes/artist.el6
-rw-r--r--lisp/textmodes/fill.el11
-rw-r--r--lisp/textmodes/reftex-vars.el18
-rw-r--r--lisp/vc/ediff-wind.el5
-rw-r--r--lisp/vc/ediff.el2
-rw-r--r--lisp/wid-edit.el14
-rw-r--r--lisp/window.el13
53 files changed, 743 insertions, 439 deletions
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 68ae4685898..d684c7ba97f 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1095,15 +1095,7 @@ Used by `calc-user-invocation'.")
1095 (ignore-errors 1095 (ignore-errors
1096 (define-key calc-digit-map x 'calcDigit-delchar) 1096 (define-key calc-digit-map x 'calcDigit-delchar)
1097 (define-key calc-mode-map x 'calc-pop) 1097 (define-key calc-mode-map x 'calc-pop)
1098 (define-key calc-mode-map 1098 (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above)))
1099 (if (and (vectorp x) (featurep 'xemacs))
1100 (if (= (length x) 1)
1101 (vector (if (consp (aref x 0))
1102 (cons 'meta (aref x 0))
1103 (list 'meta (aref x 0))))
1104 "\e\C-d")
1105 (vconcat "\e" x))
1106 'calc-pop-above)))
1107 (if calc-scan-for-dels 1099 (if calc-scan-for-dels
1108 (append (where-is-internal 'delete-forward-char global-map) 1100 (append (where-is-internal 'delete-forward-char global-map)
1109 '("\C-d")) 1101 '("\C-d"))
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index ee75e297993..e1417d7806c 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -64,24 +64,22 @@ location is varied dependent on other complex criteria, this class
64can be used to define that match without loading the specific project 64can be used to define that match without loading the specific project
65into memory.") 65into memory.")
66 66
67(cl-defmethod ede-calc-fromconfig ((dirmatch ede-project-autoload-dirmatch))
68 "Calculate the value of :fromconfig from DIRMATCH."
69 (let* ((fc (oref dirmatch fromconfig))
70 (found (cond ((stringp fc) fc)
71 ((functionp fc) (funcall fc))
72 (t (error "Unknown dirmatch object match style.")))))
73 (expand-file-name found)
74 ))
75
67(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch)) 76(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
68 "Return non-nil if the tool DIRMATCH might match is installed on the system." 77 "Return non-nil if the tool DIRMATCH might match is installed on the system."
69 (let ((fc (oref dirmatch fromconfig))) 78 (file-exists-p (ede-calc-fromconfig dirmatch)))
70
71 (cond
72 ;; If the thing to match is stored in a config file.
73 ((stringp fc)
74 (file-exists-p fc))
75
76 ;; Add new types of dirmatches here.
77
78 ;; Error for weird stuff
79 (t (error "Unknown dirmatch type.")))))
80
81 79
82(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file) 80(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
83 "Does DIRMATCH match the filename FILE." 81 "Does DIRMATCH match the filename FILE."
84 (let ((fc (oref dirmatch fromconfig))) 82 (let ((fc (ede-calc-fromconfig dirmatch)))
85 83
86 (cond 84 (cond
87 ;; If the thing to match is stored in a config file. 85 ;; If the thing to match is stored in a config file.
diff --git a/lisp/comint.el b/lisp/comint.el
index 2e683a75724..53153af7d27 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -979,6 +979,7 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
979 (ring (make-ring ring-size)) 979 (ring (make-ring ring-size))
980 ;; Use possibly buffer-local values of these variables. 980 ;; Use possibly buffer-local values of these variables.
981 (ring-separator comint-input-ring-separator) 981 (ring-separator comint-input-ring-separator)
982 (ring-file-prefix comint-input-ring-file-prefix)
982 (history-ignore comint-input-history-ignore) 983 (history-ignore comint-input-history-ignore)
983 (ignoredups comint-input-ignoredups)) 984 (ignoredups comint-input-ignoredups))
984 (with-temp-buffer 985 (with-temp-buffer
@@ -990,24 +991,15 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
990 (while (and (< count comint-input-ring-size) 991 (while (and (< count comint-input-ring-size)
991 (re-search-backward ring-separator nil t) 992 (re-search-backward ring-separator nil t)
992 (setq end (match-beginning 0))) 993 (setq end (match-beginning 0)))
993 (setq start 994 (goto-char (if (re-search-backward ring-separator nil t)
994 (if (re-search-backward ring-separator nil t) 995 (match-end 0)
995 (progn 996 (point-min)))
996 (when (and comint-input-ring-file-prefix 997 (when (and ring-file-prefix
997 (looking-at 998 (looking-at ring-file-prefix))
998 comint-input-ring-file-prefix)) 999 ;; Skip zsh extended_history stamps
999 ;; Skip zsh extended_history stamps 1000 (goto-char (match-end 0)))
1000 (goto-char (match-end 0))) 1001 (setq start (point))
1001 (match-end 0))
1002 (progn
1003 (goto-char (point-min))
1004 (when (and comint-input-ring-file-prefix
1005 (looking-at
1006 comint-input-ring-file-prefix))
1007 (goto-char (match-end 0)))
1008 (point))))
1009 (setq history (buffer-substring start end)) 1002 (setq history (buffer-substring start end))
1010 (goto-char start)
1011 (when (and (not (string-match history-ignore history)) 1003 (when (and (not (string-match history-ignore history))
1012 (or (null ignoredups) 1004 (or (null ignoredups)
1013 (ring-empty-p ring) 1005 (ring-empty-p ring)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5dcb2842a21..21fe89c6214 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -175,6 +175,7 @@
175 (choice :tag "Style" 175 (choice :tag "Style"
176 (const :tag "Raised" released-button) 176 (const :tag "Raised" released-button)
177 (const :tag "Sunken" pressed-button) 177 (const :tag "Sunken" pressed-button)
178 (const :tag "Flat" flat-button)
178 (const :tag "None" nil)))) 179 (const :tag "None" nil))))
179 ;; filter to make value suitable for customize 180 ;; filter to make value suitable for customize
180 (lambda (real-value) 181 (lambda (real-value)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 85dd14f6282..0293d34d1cd 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -394,7 +394,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
394 ;; (directory :format "%v")))) 394 ;; (directory :format "%v"))))
395 (load-prefer-newer lisp boolean "24.4") 395 (load-prefer-newer lisp boolean "24.4")
396 ;; minibuf.c 396 ;; minibuf.c
397 (minibuffer-follows-selected-frame minibuffer boolean "28.1") 397 (minibuffer-follows-selected-frame
398 minibuffer (choice (const :tag "Always" t)
399 (const :tag "When used" hybrid)
400 (const :tag "Never" nil))
401 "28.1")
398 (enable-recursive-minibuffers minibuffer boolean) 402 (enable-recursive-minibuffers minibuffer boolean)
399 (history-length minibuffer 403 (history-length minibuffer
400 (choice (const :tag "Infinite" t) integer) 404 (choice (const :tag "Infinite" t) integer)
diff --git a/lisp/custom.el b/lisp/custom.el
index d9d0898dcb7..58ecd0439ad 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -136,6 +136,9 @@ to include all of it." ; see eg vc-sccs-search-project-dir
136 ;; No longer true: 136 ;; No longer true:
137 ;; "See `send-mail-function' in sendmail.el for an example." 137 ;; "See `send-mail-function' in sendmail.el for an example."
138 138
139 ;; Defvar it so as to mark it special, etc (bug#25770).
140 (internal--define-uninitialized-variable symbol)
141
139 ;; Until the var is actually initialized, it is kept unbound. 142 ;; Until the var is actually initialized, it is kept unbound.
140 ;; This seemed to be at least as good as setting it to an arbitrary 143 ;; This seemed to be at least as good as setting it to an arbitrary
141 ;; value like nil (evaluating `value' is not an option because it 144 ;; value like nil (evaluating `value' is not an option because it
@@ -237,6 +240,8 @@ The following keywords are meaningful:
237 240
238:type VALUE should be a widget type for editing the symbol's value. 241:type VALUE should be a widget type for editing the symbol's value.
239 Every `defcustom' should specify a value for this keyword. 242 Every `defcustom' should specify a value for this keyword.
243 See Info node `(elisp) Customization Types' for a list of
244 base types and useful composite types.
240:options VALUE should be a list of valid members of the widget type. 245:options VALUE should be a list of valid members of the widget type.
241:initialize 246:initialize
242 VALUE should be a function used to initialize the 247 VALUE should be a function used to initialize the
@@ -778,8 +783,7 @@ Return non-nil if the `customized-value' property actually changed."
778Use the :set function to do so. This is useful for customizable options 783Use the :set function to do so. This is useful for customizable options
779that are defined before their standard value can really be computed. 784that are defined before their standard value can really be computed.
780E.g. dumped variables whose default depends on run-time information." 785E.g. dumped variables whose default depends on run-time information."
781 ;; If it has never been set at all, defvar it so as to mark it 786 ;; We are initializing
782 ;; special, etc (bug#25770). This means we are initializing
783 ;; the variable, and normally any :set function would not apply. 787 ;; the variable, and normally any :set function would not apply.
784 ;; For custom-initialize-delay, however, it is documented that "the 788 ;; For custom-initialize-delay, however, it is documented that "the
785 ;; (delayed) initialization is performed with the :set function". 789 ;; (delayed) initialization is performed with the :set function".
@@ -787,11 +791,10 @@ E.g. dumped variables whose default depends on run-time information."
787 ;; custom-initialize-delay but needs the :set function custom-set-minor-mode 791 ;; custom-initialize-delay but needs the :set function custom-set-minor-mode
788 ;; to also run during initialization. So, long story short, we 792 ;; to also run during initialization. So, long story short, we
789 ;; always do the funcall step, even if symbol was not bound before. 793 ;; always do the funcall step, even if symbol was not bound before.
790 (or (default-boundp symbol)
791 (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
792 (funcall (or (get symbol 'custom-set) #'set-default) 794 (funcall (or (get symbol 'custom-set) #'set-default)
793 symbol 795 symbol
794 (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) 796 (eval (car (or (get symbol 'saved-value)
797 (get symbol 'standard-value))))))
795 798
796 799
797;;; Custom Themes 800;;; Custom Themes
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52eccbbe3..aebffe339eb 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1483,7 +1483,7 @@ a prefix argument, when it offers the filename near point as a default."
1483;;; Internal functions. 1483;;; Internal functions.
1484 1484
1485;; Fixme: This should probably use `thing-at-point'. -- fx 1485;; Fixme: This should probably use `thing-at-point'. -- fx
1486(define-obsolete-function-alias 'dired-filename-at-point 1486(define-obsolete-function-alias 'dired-file-name-at-point
1487 #'dired-x-guess-file-name-at-point "28.1") 1487 #'dired-x-guess-file-name-at-point "28.1")
1488(defun dired-x-guess-file-name-at-point () 1488(defun dired-x-guess-file-name-at-point ()
1489 "Return the filename closest to point, expanded. 1489 "Return the filename closest to point, expanded.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 19dd54c8645..8e36dbe4a36 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY."
304 (lambda ,args ,@body)))) 304 (lambda ,args ,@body))))
305 305
306(eval-and-compile ;Needed while compiling the cl-defmethod calls below! 306(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
307 (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
308 "Check which of the symbols VARS appear in SEXP."
309 (let ((res '()))
310 (while (consp sexp)
311 (dolist (var (cl--generic-fgrep vars (pop sexp)))
312 (unless (memq var res) (push var res))))
313 (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
314 res))
315
316 (defun cl--generic-split-args (args) 307 (defun cl--generic-split-args (args)
317 "Return (SPEC-ARGS . PLAIN-ARGS)." 308 "Return (SPEC-ARGS . PLAIN-ARGS)."
318 (let ((plain-args ()) 309 (let ((plain-args ())
@@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY."
375 ;; is used. 366 ;; is used.
376 ;; FIXME: Also, optimize the case where call-next-method is 367 ;; FIXME: Also, optimize the case where call-next-method is
377 ;; only called with explicit arguments. 368 ;; only called with explicit arguments.
378 (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) 369 (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
379 (cons (not (not uses-cnm)) 370 (cons (not (not uses-cnm))
380 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) 371 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
381 ,@(car parsed-body) 372 ,@(car parsed-body)
382 ,(if (not (memq nmp uses-cnm)) 373 ,(if (not (assq nmp uses-cnm))
383 nbody 374 nbody
384 `(let ((,nmp (lambda () 375 `(let ((,nmp (lambda ()
385 (cl--generic-isnot-nnm-p ,cnm)))) 376 (cl--generic-isnot-nnm-p ,cnm))))
@@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
617 (lambda (,@fixedargs &rest args) 608 (lambda (,@fixedargs &rest args)
618 (let ,bindings 609 (let ,bindings
619 (apply (cl--generic-with-memoization 610 (apply (cl--generic-with-memoization
620 (gethash ,tag-exp method-cache) 611 (gethash ,tag-exp method-cache)
621 (cl--generic-cache-miss 612 (cl--generic-cache-miss
622 generic ',dispatch-arg dispatches-left methods 613 generic ',dispatch-arg dispatches-left methods
623 ,(if (cdr typescodes) 614 ,(if (cdr typescodes)
624 `(append ,@typescodes) (car typescodes)))) 615 `(append ,@typescodes) (car typescodes))))
625 ,@fixedargs args))))))))) 616 ,@fixedargs args)))))))))
626 617
627(defun cl--generic-make-function (generic) 618(defun cl--generic-make-function (generic)
@@ -1110,7 +1101,8 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
1110 (if (not (eq (car-safe specializer) 'head)) 1101 (if (not (eq (car-safe specializer) 'head))
1111 (cl-call-next-method) 1102 (cl-call-next-method)
1112 (cl--generic-with-memoization 1103 (cl--generic-with-memoization
1113 (gethash (cadr specializer) cl--generic-head-used) specializer) 1104 (gethash (cadr specializer) cl--generic-head-used)
1105 specializer)
1114 (list cl--generic-head-generalizer))) 1106 (list cl--generic-head-generalizer)))
1115 1107
1116(cl--generic-prefill-dispatchers 0 (head eql)) 1108(cl--generic-prefill-dispatchers 0 (head eql))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index ac7360b935b..fb43a0bc956 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2060,10 +2060,99 @@ Like `cl-flet' but the definitions can refer to previous ones.
2060 ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) 2060 ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
2061 (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) 2061 (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
2062 2062
2063(defun cl--self-tco (var fargs body)
2064 ;; This tries to "optimize" tail calls for the specific case
2065 ;; of recursive self-calls by replacing them with a `while' loop.
2066 ;; It is quite far from a general tail-call optimization, since it doesn't
2067 ;; even handle mutually recursive functions.
2068 (letrec
2069 ((done nil) ;; Non-nil if some TCO happened.
2070 (retvar (make-symbol "retval"))
2071 (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
2072 (make-symbol (symbol-name s))))
2073 fargs))
2074 (opt-exps (lambda (exps) ;; `exps' is in tail position!
2075 (append (butlast exps)
2076 (list (funcall opt (car (last exps)))))))
2077 (opt
2078 (lambda (exp) ;; `exp' is in tail position!
2079 (pcase exp
2080 ;; FIXME: Optimize `apply'?
2081 (`(funcall ,(pred (eq var)) . ,aargs)
2082 ;; This is a self-recursive call in tail position.
2083 (let ((sets nil)
2084 (fargs ofargs))
2085 (while fargs
2086 (pcase (pop fargs)
2087 ('&rest
2088 (push (pop fargs) sets)
2089 (push `(list . ,aargs) sets)
2090 ;; (cl-assert (null fargs))
2091 )
2092 ('&optional nil)
2093 (farg
2094 (push farg sets)
2095 (push (pop aargs) sets))))
2096 (setq done t)
2097 `(progn (setq . ,(nreverse sets))
2098 :recurse)))
2099 (`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
2100 (`(if ,cond ,then . ,else)
2101 `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
2102 (`(cond . ,conds)
2103 (let ((cs '()))
2104 (while conds
2105 (pcase (pop conds)
2106 (`(,exp)
2107 (push (if conds
2108 ;; This returns the value of `exp' but it's
2109 ;; only in tail position if it's the
2110 ;; last condition.
2111 `((setq ,retvar ,exp) nil)
2112 `(,(funcall opt exp)))
2113 cs))
2114 (exps
2115 (push (funcall opt-exps exps) cs))))
2116 (if (eq t (caar cs))
2117 `(cond . ,(nreverse cs))
2118 `(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
2119 ((and `(,(or 'let 'let*) ,bindings . ,exps)
2120 (guard
2121 ;; Note: it's OK for this `let' to shadow any
2122 ;; of the formal arguments since we will only
2123 ;; setq the fresh new `ofargs' vars instead ;-)
2124 (let ((shadowings
2125 (mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
2126 ;; If `var' is shadowed, then it clearly can't be
2127 ;; tail-called any more.
2128 (not (memq var shadowings)))))
2129 `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
2130 (_
2131 `(progn (setq ,retvar ,exp) nil))))))
2132
2133 (let ((optimized-body (funcall opt-exps body)))
2134 (if (not done)
2135 (cons fargs body)
2136 ;; We use two sets of vars: `ofargs' and `fargs' because we need
2137 ;; to be careful that if a closure captures a formal argument
2138 ;; in one iteration, it needs to capture a different binding
2139 ;; then that of other iterations, e.g.
2140 (cons
2141 ofargs
2142 `((let (,retvar)
2143 (while (let ,(delq nil
2144 (cl-mapcar
2145 (lambda (a oa)
2146 (unless (memq a cl--lambda-list-keywords)
2147 (list a oa)))
2148 fargs ofargs))
2149 . ,optimized-body))
2150 ,retvar)))))))
2151
2063;;;###autoload 2152;;;###autoload
2064(defmacro cl-labels (bindings &rest body) 2153(defmacro cl-labels (bindings &rest body)
2065 "Make local (recursive) function definitions. 2154 "Make local (recursive) function definitions.
2066Each definition can take the form (FUNC ARGLIST BODY...) where 2155+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
2067FUNC is the function name, ARGLIST its arguments, and BODY the 2156FUNC is the function name, ARGLIST its arguments, and BODY the
2068forms of the function body. FUNC is defined in any BODY, as well 2157forms of the function body. FUNC is defined in any BODY, as well
2069as FORM, so you can write recursive and mutually recursive 2158as FORM, so you can write recursive and mutually recursive
@@ -2075,17 +2164,33 @@ details.
2075 (let ((binds ()) (newenv macroexpand-all-environment)) 2164 (let ((binds ()) (newenv macroexpand-all-environment))
2076 (dolist (binding bindings) 2165 (dolist (binding bindings)
2077 (let ((var (make-symbol (format "--cl-%s--" (car binding))))) 2166 (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
2078 (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) 2167 (push (cons var (cdr binding)) binds)
2079 (push (cons (car binding) 2168 (push (cons (car binding)
2080 (lambda (&rest args) 2169 (lambda (&rest args)
2081 (if (eq (car args) cl--labels-magic) 2170 (if (eq (car args) cl--labels-magic)
2082 (list cl--labels-magic var) 2171 (list cl--labels-magic var)
2083 (cl-list* 'funcall var args)))) 2172 (cl-list* 'funcall var args))))
2084 newenv))) 2173 newenv)))
2085 (macroexpand-all `(letrec ,(nreverse binds) ,@body) 2174 ;; Don't override lexical-let's macro-expander.
2086 ;; Don't override lexical-let's macro-expander. 2175 (unless (assq 'function newenv)
2087 (if (assq 'function newenv) newenv 2176 (push (cons 'function #'cl--labels-convert) newenv))
2088 (cons (cons 'function #'cl--labels-convert) newenv))))) 2177 ;; Perform self-tail call elimination.
2178 (setq binds (mapcar
2179 (lambda (bind)
2180 (pcase-let*
2181 ((`(,var ,sargs . ,sbody) bind)
2182 (`(function (lambda ,fargs . ,ebody))
2183 (macroexpand-all `(cl-function (lambda ,sargs . ,sbody))
2184 newenv))
2185 (`(,ofargs . ,obody)
2186 (cl--self-tco var fargs ebody)))
2187 `(,var (function (lambda ,ofargs . ,obody)))))
2188 (nreverse binds)))
2189 `(letrec ,binds
2190 . ,(macroexp-unprogn
2191 (macroexpand-all
2192 (macroexp-progn body)
2193 newenv)))))
2089 2194
2090;; The following ought to have a better definition for use with newer 2195;; The following ought to have a better definition for use with newer
2091;; byte compilers. 2196;; byte compilers.
@@ -3413,8 +3518,8 @@ macro that returns its `&whole' argument."
3413 (put y 'side-effect-free t)) 3518 (put y 'side-effect-free t))
3414 3519
3415;;; Things that are inline. 3520;;; Things that are inline.
3416(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany 3521(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend
3417 cl-notevery cl-revappend cl-nreconc gethash)) 3522 cl-nreconc gethash))
3418 3523
3419;;; Things that are side-effect-free. 3524;;; Things that are side-effect-free.
3420(mapc (lambda (x) (function-put x 'side-effect-free t)) 3525(mapc (lambda (x) (function-put x 'side-effect-free t))
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 4ba72aea56d..ec1077d447e 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -162,6 +162,59 @@ only one object ever exists."
162 old))) 162 old)))
163 163
164 164
165;;; Named object
166
167(defclass eieio-named ()
168 ((object-name :initarg :object-name :initform nil))
169 "Object with a name."
170 :abstract t)
171
172(cl-defmethod eieio-object-name-string ((obj eieio-named))
173 "Return a string which is OBJ's name."
174 (or (slot-value obj 'object-name)
175 (cl-call-next-method)))
176
177(cl-defgeneric eieio-object-set-name-string (obj name)
178 "Set the string which is OBJ's NAME."
179 (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1"))
180 (cl-check-type name string)
181 (setf (gethash obj eieio--object-names) name))
182(define-obsolete-function-alias
183 'object-set-name-string 'eieio-object-set-name-string "24.4")
184
185(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
186 (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
187 "Set the string which is OBJ's NAME."
188 (cl-check-type name string)
189 (eieio-oset obj 'object-name name)))
190
191(cl-defmethod clone ((obj eieio-named) &rest params)
192 "Clone OBJ, initializing `:parent' to OBJ.
193All slots are unbound, except those initialized with PARAMS."
194 (let* ((newname (and (stringp (car params)) (pop params)))
195 (nobj (apply #'cl-call-next-method obj params))
196 (nm (slot-value nobj 'object-name)))
197 (eieio-oset nobj 'object-name
198 (or newname
199 (if (equal nm (slot-value obj 'object-name))
200 (save-match-data
201 (if (and nm (string-match "-\\([0-9]+\\)" nm))
202 (let ((num (1+ (string-to-number
203 (match-string 1 nm)))))
204 (concat (substring nm 0 (match-beginning 0))
205 "-" (int-to-string num)))
206 (concat nm "-1")))
207 nm)))
208 nobj))
209
210(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
211 (if (not (stringp (car args)))
212 (cl-call-next-method)
213 (funcall (if eieio-backward-compatibility #'ignore #'message)
214 "Obsolete: name passed without :object-name to %S constructor"
215 class)
216 (apply #'cl-call-next-method class :object-name args)))
217
165;;; eieio-persistent 218;;; eieio-persistent
166;; 219;;
167;; For objects which must save themselves to disk. Provides an 220;; For objects which must save themselves to disk. Provides an
@@ -264,12 +317,17 @@ objects found there."
264 (:method 317 (:method
265 ((objclass (subclass eieio-default-superclass)) inputlist) 318 ((objclass (subclass eieio-default-superclass)) inputlist)
266 319
267 (let ((slots (if (stringp (car inputlist)) 320 (let* ((name nil)
268 ;; Earlier versions of `object-write' added a 321 (slots (if (stringp (car inputlist))
269 ;; string name for the object, now obsolete. 322 (progn
270 (cdr inputlist) 323 ;; Earlier versions of `object-write' added a
271 inputlist)) 324 ;; string name for the object, now obsolete.
272 (createslots nil)) 325 ;; Save as 'name' in case this object is subclass
326 ;; of eieio-named with no :object-name slot specified.
327 (setq name (car inputlist))
328 (cdr inputlist))
329 inputlist))
330 (createslots nil))
273 ;; If OBJCLASS is an eieio autoload object, then we need to 331 ;; If OBJCLASS is an eieio autoload object, then we need to
274 ;; load it (we don't need the return value). 332 ;; load it (we don't need the return value).
275 (eieio--full-class-object objclass) 333 (eieio--full-class-object objclass)
@@ -286,7 +344,17 @@ objects found there."
286 344
287 (setq slots (cdr (cdr slots)))) 345 (setq slots (cdr (cdr slots))))
288 346
289 (apply #'make-instance objclass (nreverse createslots))))) 347 (let ((newobj (apply #'make-instance objclass (nreverse createslots))))
348
349 ;; Check for special case of subclass of `eieio-named', and do
350 ;; name assignment.
351 (when (and eieio-backward-compatibility
352 (object-of-class-p newobj 'eieio-named)
353 (not (oref newobj object-name))
354 name)
355 (oset newobj object-name name))
356
357 newobj))))
290 358
291(defun eieio-persistent-fix-value (proposed-value) 359(defun eieio-persistent-fix-value (proposed-value)
292 "Fix PROPOSED-VALUE. 360 "Fix PROPOSED-VALUE.
@@ -408,59 +476,6 @@ instance."
408;; It should also set up some hooks to help it keep itself up to date. 476;; It should also set up some hooks to help it keep itself up to date.
409 477
410 478
411;;; Named object
412
413(defclass eieio-named ()
414 ((object-name :initarg :object-name :initform nil))
415 "Object with a name."
416 :abstract t)
417
418(cl-defmethod eieio-object-name-string ((obj eieio-named))
419 "Return a string which is OBJ's name."
420 (or (slot-value obj 'object-name)
421 (cl-call-next-method)))
422
423(cl-defgeneric eieio-object-set-name-string (obj name)
424 "Set the string which is OBJ's NAME."
425 (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1"))
426 (cl-check-type name string)
427 (setf (gethash obj eieio--object-names) name))
428(define-obsolete-function-alias
429 'object-set-name-string 'eieio-object-set-name-string "24.4")
430
431(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
432 (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
433 "Set the string which is OBJ's NAME."
434 (cl-check-type name string)
435 (eieio-oset obj 'object-name name)))
436
437(cl-defmethod clone ((obj eieio-named) &rest params)
438 "Clone OBJ, initializing `:parent' to OBJ.
439All slots are unbound, except those initialized with PARAMS."
440 (let* ((newname (and (stringp (car params)) (pop params)))
441 (nobj (apply #'cl-call-next-method obj params))
442 (nm (slot-value nobj 'object-name)))
443 (eieio-oset nobj 'object-name
444 (or newname
445 (if (equal nm (slot-value obj 'object-name))
446 (save-match-data
447 (if (and nm (string-match "-\\([0-9]+\\)" nm))
448 (let ((num (1+ (string-to-number
449 (match-string 1 nm)))))
450 (concat (substring nm 0 (match-beginning 0))
451 "-" (int-to-string num)))
452 (concat nm "-1")))
453 nm)))
454 nobj))
455
456(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
457 (if (not (stringp (car args)))
458 (cl-call-next-method)
459 (funcall (if eieio-backward-compatibility #'ignore #'message)
460 "Obsolete: name passed without :object-name to %S constructor"
461 class)
462 (apply #'cl-call-next-method class :object-name args)))
463
464 479
465(provide 'eieio-base) 480(provide 'eieio-base)
466 481
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 1ae216c1a27..8780c5dcd30 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -456,8 +456,7 @@ This will generate compile-time constants from BINDINGS."
456 ("\\(\\\\\\)\\([^\"\\]\\)" 456 ("\\(\\\\\\)\\([^\"\\]\\)"
457 (1 (elisp--font-lock-backslash) prepend)) 457 (1 (elisp--font-lock-backslash) prepend))
458 ;; Words inside ‘’ and `' tend to be symbol names. 458 ;; Words inside ‘’ and `' tend to be symbol names.
459 (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)" 459 (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
460 lisp-mode-symbol-regexp "\\)['’]")
461 (1 font-lock-constant-face prepend)) 460 (1 font-lock-constant-face prepend))
462 ;; Constant values. 461 ;; Constant values.
463 (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") 462 (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
@@ -507,8 +506,7 @@ This will generate compile-time constants from BINDINGS."
507 (,(concat "(" cl-errs-re "\\_>") 506 (,(concat "(" cl-errs-re "\\_>")
508 (1 font-lock-warning-face)) 507 (1 font-lock-warning-face))
509 ;; Words inside ‘’ and `' tend to be symbol names. 508 ;; Words inside ‘’ and `' tend to be symbol names.
510 (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)" 509 (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
511 lisp-mode-symbol-regexp "\\)['’]")
512 (1 font-lock-constant-face prepend)) 510 (1 font-lock-constant-face prepend))
513 ;; Uninterned symbols, e.g., (defpackage #:my-package ...) 511 ;; Uninterned symbols, e.g., (defpackage #:my-package ...)
514 ;; must come before keywords below to have effect 512 ;; must come before keywords below to have effect
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 82a8cd2d777..37844977f8f 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -480,6 +480,35 @@ itself or not."
480 v 480 v
481 (list 'quote v))) 481 (list 'quote v)))
482 482
483(defun macroexp--fgrep (bindings sexp)
484 "Return those of the BINDINGS which might be used in SEXP.
485It is used as a poor-man's \"free variables\" test. It differs from a true
486test of free variables in the following ways:
487- It does not distinguish variables from functions, so it can be used
488 both to detect whether a given variable is used by SEXP and to
489 detect whether a given function is used by SEXP.
490- It does not actually know ELisp syntax, so it only looks for the presence
491 of symbols in SEXP and can't distinguish if those symbols are truly
492 references to the given variable (or function). That can make the result
493 include bindings which actually aren't used.
494- For the same reason it may cause the result to fail to include bindings
495 which will be used if SEXP is not yet fully macro-expanded and the
496 use of the binding will only be revealed by macro expansion."
497 (let ((res '()))
498 (while (and (consp sexp) bindings)
499 (dolist (binding (macroexp--fgrep bindings (pop sexp)))
500 (push binding res)
501 (setq bindings (remove binding bindings))))
502 (if (or (vectorp sexp) (byte-code-function-p sexp))
503 ;; With backquote, code can appear within vectors as well.
504 ;; This wouldn't be needed if we `macroexpand-all' before
505 ;; calling macroexp--fgrep, OTOH.
506 (macroexp--fgrep bindings (mapcar #'identity sexp))
507 (let ((tmp (assq sexp bindings)))
508 (if tmp
509 (cons tmp res)
510 res)))))
511
483;;; Load-time macro-expansion. 512;;; Load-time macro-expansion.
484 513
485;; Because macro-expansion used to be more lazy, eager macro-expansion 514;; Because macro-expansion used to be more lazy, eager macro-expansion
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 8fb79d220de..72ea1ba0188 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,7 @@ of the elements of LIST is performed as if by `pcase-let'.
344 (seen '()) 344 (seen '())
345 (codegen 345 (codegen
346 (lambda (code vars) 346 (lambda (code vars)
347 (let ((vars (pcase--fgrep vars code)) 347 (let ((vars (macroexp--fgrep vars code))
348 (prev (assq code seen))) 348 (prev (assq code seen)))
349 (if (not prev) 349 (if (not prev)
350 (let ((res (pcase-codegen code vars))) 350 (let ((res (pcase-codegen code vars)))
@@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'.
401 ;; occurrences of this leaf since it's small. 401 ;; occurrences of this leaf since it's small.
402 (lambda (code vars) 402 (lambda (code vars)
403 (pcase-codegen code 403 (pcase-codegen code
404 (pcase--fgrep vars code))) 404 (macroexp--fgrep vars code)))
405 codegen) 405 codegen)
406 (cdr case) 406 (cdr case)
407 vars)))) 407 vars))))
@@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form:
668 ;; run, but we don't have the environment in which `pat' will 668 ;; run, but we don't have the environment in which `pat' will
669 ;; run, so we can't do a reliable verification. But let's try 669 ;; run, so we can't do a reliable verification. But let's try
670 ;; and catch at least the easy cases such as (bug#14773). 670 ;; and catch at least the easy cases such as (bug#14773).
671 (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) 671 (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
672 '(:pcase--succeed . :pcase--fail)) 672 '(:pcase--succeed . :pcase--fail))
673 ((and (eq 'pred (car upat)) 673 ((and (eq 'pred (car upat))
674 (let ((otherpred 674 (let ((otherpred
@@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form:
692 '(nil . :pcase--fail) 692 '(nil . :pcase--fail)
693 '(:pcase--fail . nil)))))) 693 '(:pcase--fail . nil))))))
694 694
695(defun pcase--fgrep (bindings sexp)
696 "Return those of the BINDINGS which might be used in SEXP."
697 (let ((res '()))
698 (while (and (consp sexp) bindings)
699 (dolist (binding (pcase--fgrep bindings (pop sexp)))
700 (push binding res)
701 (setq bindings (remove binding bindings))))
702 (if (vectorp sexp)
703 ;; With backquote, code can appear within vectors as well.
704 ;; This wouldn't be needed if we `macroexpand-all' before
705 ;; calling pcase--fgrep, OTOH.
706 (pcase--fgrep bindings (mapcar #'identity sexp))
707 (let ((tmp (assq sexp bindings)))
708 (if tmp
709 (cons tmp res)
710 res)))))
711
712(defun pcase--self-quoting-p (upat) 695(defun pcase--self-quoting-p (upat)
713 (or (keywordp upat) (integerp upat) (stringp upat))) 696 (or (keywordp upat) (integerp upat) (stringp upat)))
714 697
@@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form:
749 `(,fun ,arg) 732 `(,fun ,arg)
750 (let* (;; `env' is an upper bound on the bindings we need. 733 (let* (;; `env' is an upper bound on the bindings we need.
751 (env (mapcar (lambda (x) (list (car x) (cdr x))) 734 (env (mapcar (lambda (x) (list (car x) (cdr x)))
752 (pcase--fgrep vars fun))) 735 (macroexp--fgrep vars fun)))
753 (call (progn 736 (call (progn
754 (when (assq arg env) 737 (when (assq arg env)
755 ;; `arg' is shadowed by `env'. 738 ;; `arg' is shadowed by `env'.
@@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form:
770 "Build an expression that will evaluate EXP." 753 "Build an expression that will evaluate EXP."
771 (let* ((found (assq exp vars))) 754 (let* ((found (assq exp vars)))
772 (if found (cdr found) 755 (if found (cdr found)
773 (let* ((env (pcase--fgrep vars exp))) 756 (let* ((env (macroexp--fgrep vars exp)))
774 (if env 757 (if env
775 (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) 758 (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
776 env) 759 env)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 698467e939e..39e69f5aab9 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1126,12 +1126,21 @@ There can be any number of :example/:result elements."
1126 (insert (propertize "(" 1126 (insert (propertize "("
1127 'shortdoc-function t)) 1127 'shortdoc-function t))
1128 (if (plist-get data :no-manual) 1128 (if (plist-get data :no-manual)
1129 (insert (symbol-name function)) 1129 (insert-text-button
1130 (symbol-name function)
1131 'face 'button
1132 'action (lambda (_)
1133 (describe-function function))
1134 'follow-link t
1135 'help-echo (purecopy "mouse-1, RET: describe function"))
1130 (insert-text-button 1136 (insert-text-button
1131 (symbol-name function) 1137 (symbol-name function)
1132 'face 'button 1138 'face 'button
1133 'action (lambda (_) 1139 'action (lambda (_)
1134 (info-lookup-symbol function 'emacs-lisp-mode)))) 1140 (info-lookup-symbol function 'emacs-lisp-mode))
1141 'follow-link t
1142 'help-echo (purecopy "mouse-1, RET: show \
1143function's documentation in the Info manual")))
1135 (setq arglist-start (point)) 1144 (setq arglist-start (point))
1136 (insert ")\n") 1145 (insert ")\n")
1137 ;; Doc string. 1146 ;; Doc string.
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 4f9b0b199f9..9ef8b7f46ab 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -168,8 +168,19 @@ You can also use \\[erc-nickserv-identify-mode] to change modes."
168 :group 'erc-services 168 :group 'erc-services
169 :type 'boolean) 169 :type 'boolean)
170 170
171(defcustom erc-use-auth-source-for-nickserv-password nil
172 "Query auth-source for a password when identifiying to NickServ.
173This option has an no effect if `erc-prompt-for-nickserv-password'
174is non-nil, and passwords from `erc-nickserv-passwords' take
175precedence."
176 :version "28.1"
177 :group 'erc-services
178 :type 'boolean)
179
171(defcustom erc-nickserv-passwords nil 180(defcustom erc-nickserv-passwords nil
172 "Passwords used when identifying to NickServ automatically. 181 "Passwords used when identifying to NickServ automatically.
182`erc-prompt-for-nickserv-password' must be nil for these
183passwords to be used.
173 184
174Example of use: 185Example of use:
175 (setq erc-nickserv-passwords 186 (setq erc-nickserv-passwords
@@ -375,7 +386,8 @@ Make sure it is the real NickServ for this network.
375If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the 386If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
376password for this nickname, otherwise try to send it automatically." 387password for this nickname, otherwise try to send it automatically."
377 (unless (and (null erc-nickserv-passwords) 388 (unless (and (null erc-nickserv-passwords)
378 (null erc-prompt-for-nickserv-password)) 389 (null erc-prompt-for-nickserv-password)
390 (null erc-use-auth-source-for-nickserv-password))
379 (let* ((network (erc-network)) 391 (let* ((network (erc-network))
380 (sender (erc-nickserv-alist-sender network)) 392 (sender (erc-nickserv-alist-sender network))
381 (identify-regex (erc-nickserv-alist-regexp network)) 393 (identify-regex (erc-nickserv-alist-regexp network))
@@ -394,30 +406,49 @@ password for this nickname, otherwise try to send it automatically."
394(defun erc-nickserv-identify-on-connect (_server nick) 406(defun erc-nickserv-identify-on-connect (_server nick)
395 "Identify to Nickserv after the connection to the server is established." 407 "Identify to Nickserv after the connection to the server is established."
396 (unless (or (and (null erc-nickserv-passwords) 408 (unless (or (and (null erc-nickserv-passwords)
397 (null erc-prompt-for-nickserv-password)) 409 (null erc-prompt-for-nickserv-password)
398 (and (eq erc-nickserv-identify-mode 'both) 410 (null erc-use-auth-source-for-nickserv-password))
399 (erc-nickserv-alist-regexp (erc-network)))) 411 (and (eq erc-nickserv-identify-mode 'both)
412 (erc-nickserv-alist-regexp (erc-network))))
400 (erc-nickserv-call-identify-function nick))) 413 (erc-nickserv-call-identify-function nick)))
401 414
402(defun erc-nickserv-identify-on-nick-change (nick _old-nick) 415(defun erc-nickserv-identify-on-nick-change (nick _old-nick)
403 "Identify to Nickserv whenever your nick changes." 416 "Identify to Nickserv whenever your nick changes."
404 (unless (or (and (null erc-nickserv-passwords) 417 (unless (or (and (null erc-nickserv-passwords)
405 (null erc-prompt-for-nickserv-password)) 418 (null erc-prompt-for-nickserv-password)
406 (and (eq erc-nickserv-identify-mode 'both) 419 (null erc-use-auth-source-for-nickserv-password))
407 (erc-nickserv-alist-regexp (erc-network)))) 420 (and (eq erc-nickserv-identify-mode 'both)
421 (erc-nickserv-alist-regexp (erc-network))))
408 (erc-nickserv-call-identify-function nick))) 422 (erc-nickserv-call-identify-function nick)))
409 423
424(defun erc-nickserv-get-password (nickname)
425 "Return the password for NICKNAME from configured sources.
426
427It uses `erc-nickserv-passwords' and additionally auth-source
428when `erc-use-auth-source-for-nickserv-password' is not nil."
429 (or
430 (when erc-nickserv-passwords
431 (cdr (assoc nickname
432 (nth 1 (assoc (erc-network)
433 erc-nickserv-passwords)))))
434 (when erc-use-auth-source-for-nickserv-password
435 (let* ((secret (nth 0 (auth-source-search
436 :max 1 :require '(:secret)
437 :host (erc-with-server-buffer erc-session-server)
438 :port (format ; ensure we have a string
439 "%s" (erc-with-server-buffer erc-session-port))
440 :user nickname))))
441 (when secret
442 (let ((passwd (plist-get secret :secret)))
443 (if (functionp passwd) (funcall passwd) passwd)))))))
444
410(defun erc-nickserv-call-identify-function (nickname) 445(defun erc-nickserv-call-identify-function (nickname)
411 "Call `erc-nickserv-identify'. 446 "Call `erc-nickserv-identify'.
412Either call it interactively or run it with NICKNAME's password, 447Either call it interactively or run it with NICKNAME's password,
413depending on the value of `erc-prompt-for-nickserv-password'." 448depending on the value of `erc-prompt-for-nickserv-password'."
414 (if erc-prompt-for-nickserv-password 449 (if erc-prompt-for-nickserv-password
415 (call-interactively 'erc-nickserv-identify) 450 (call-interactively 'erc-nickserv-identify)
416 (when erc-nickserv-passwords 451 (erc-nickserv-identify (erc-nickserv-get-password nickname))))
417 (erc-nickserv-identify
418 (cdr (assoc nickname
419 (nth 1 (assoc (erc-network)
420 erc-nickserv-passwords))))))))
421 452
422(defvar erc-auto-discard-away) 453(defvar erc-auto-discard-away)
423 454
@@ -451,6 +482,7 @@ When called interactively, read the password using `read-passwd'."
451 482
452(provide 'erc-services) 483(provide 'erc-services)
453 484
485
454;;; erc-services.el ends here 486;;; erc-services.el ends here
455;; 487;;
456;; Local Variables: 488;; Local Variables:
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 771b81e5be5..4c479d68e9a 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -487,7 +487,7 @@ What happens depends on the number of mouse clicks:-
487Signal an error if the final event isn't the same type as the first one." 487Signal an error if the final event isn't the same type as the first one."
488 (let ((initial-event-type (event-basic-type event))) 488 (let ((initial-event-type (event-basic-type event)))
489 (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) 489 (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay))
490 (setq event (read-event))) 490 (setq event (read--potential-mouse-event)))
491 (or (eq initial-event-type (event-basic-type event)) 491 (or (eq initial-event-type (event-basic-type event))
492 (error ""))) 492 (error "")))
493 event) 493 event)
diff --git a/lisp/frame.el b/lisp/frame.el
index c71276287aa..e2d7f21a498 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2557,7 +2557,7 @@ command starts, by installing a pre-command hook."
2557 ;; blink-cursor-end is not added to pre-command-hook. 2557 ;; blink-cursor-end is not added to pre-command-hook.
2558 (setq blink-cursor-blinks-done 1) 2558 (setq blink-cursor-blinks-done 1)
2559 (blink-cursor--start-timer) 2559 (blink-cursor--start-timer)
2560 (add-hook 'pre-command-hook 'blink-cursor-end) 2560 (add-hook 'pre-command-hook #'blink-cursor-end)
2561 (internal-show-cursor nil nil))) 2561 (internal-show-cursor nil nil)))
2562 2562
2563(defun blink-cursor-timer-function () 2563(defun blink-cursor-timer-function ()
@@ -2572,14 +2572,14 @@ command starts, by installing a pre-command hook."
2572 (when (and (> blink-cursor-blinks 0) 2572 (when (and (> blink-cursor-blinks 0)
2573 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) 2573 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
2574 (blink-cursor-suspend) 2574 (blink-cursor-suspend)
2575 (add-hook 'post-command-hook 'blink-cursor-check))) 2575 (add-hook 'post-command-hook #'blink-cursor-check)))
2576 2576
2577(defun blink-cursor-end () 2577(defun blink-cursor-end ()
2578 "Stop cursor blinking. 2578 "Stop cursor blinking.
2579This is installed as a pre-command hook by `blink-cursor-start'. 2579This is installed as a pre-command hook by `blink-cursor-start'.
2580When run, it cancels the timer `blink-cursor-timer' and removes 2580When run, it cancels the timer `blink-cursor-timer' and removes
2581itself as a pre-command hook." 2581itself as a pre-command hook."
2582 (remove-hook 'pre-command-hook 'blink-cursor-end) 2582 (remove-hook 'pre-command-hook #'blink-cursor-end)
2583 (internal-show-cursor nil t) 2583 (internal-show-cursor nil t)
2584 (when blink-cursor-timer 2584 (when blink-cursor-timer
2585 (cancel-timer blink-cursor-timer) 2585 (cancel-timer blink-cursor-timer)
@@ -2648,7 +2648,7 @@ terminals, cursor blinking is controlled by the terminal."
2648 (when blink-cursor-mode 2648 (when blink-cursor-mode
2649 (add-function :after after-focus-change-function #'blink-cursor--rescan-frames) 2649 (add-function :after after-focus-change-function #'blink-cursor--rescan-frames)
2650 (add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames) 2650 (add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames)
2651 (blink-cursor--start-idle-timer))) 2651 (blink-cursor-check)))
2652 2652
2653 2653
2654;; Frame maximization/fullscreen 2654;; Frame maximization/fullscreen
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 44f43b073c8..5c6a5b9efd0 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1036,7 +1036,7 @@ Responsible for handling and, or, and parenthetical expressions.")
1036 '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw 1036 '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw
1037 answered before deleted draft flagged on since recent seen sentbefore 1037 answered before deleted draft flagged on since recent seen sentbefore
1038 senton sentsince unanswered undeleted undraft unflagged unkeyword 1038 senton sentsince unanswered undeleted undraft unflagged unkeyword
1039 unseen all) 1039 unseen all old new or not)
1040 "Known IMAP search keys.") 1040 "Known IMAP search keys.")
1041 1041
1042;; imap interface 1042;; imap interface
@@ -1072,10 +1072,11 @@ Responsible for handling and, or, and parenthetical expressions.")
1072 ;; A bit of backward-compatibility slash convenience: if the 1072 ;; A bit of backward-compatibility slash convenience: if the
1073 ;; query string doesn't start with any known IMAP search 1073 ;; query string doesn't start with any known IMAP search
1074 ;; keyword, assume it is a "TEXT" search. 1074 ;; keyword, assume it is a "TEXT" search.
1075 (unless (and (string-match "\\`[^[:blank:]]+" q-string) 1075 (unless (or (looking-at "(")
1076 (memql (intern-soft (downcase 1076 (and (string-match "\\`[^[:blank:]]+" q-string)
1077 (match-string 0 q-string))) 1077 (memql (intern-soft (downcase
1078 gnus-search-imap-search-keys)) 1078 (match-string 0 q-string)))
1079 gnus-search-imap-search-keys)))
1079 (setq q-string (concat "TEXT " q-string))) 1080 (setq q-string (concat "TEXT " q-string)))
1080 1081
1081 ;; If it's a thread query, make sure that all message-id 1082 ;; If it's a thread query, make sure that all message-id
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 18924a3ad0e..3fb8e469d04 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -145,7 +145,6 @@ used to display Gnus windows."
145 (,shell-command-buffer-name 1.0))) 145 (,shell-command-buffer-name 1.0)))
146 (bug 146 (bug
147 (vertical 1.0 147 (vertical 1.0
148 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
149 ("*Gnus Bug*" 1.0 point))) 148 ("*Gnus Bug*" 1.0 point)))
150 (score-trace 149 (score-trace
151 (vertical 1.0 150 (vertical 1.0
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3ff3d29b45d..50e02187484 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -620,8 +620,8 @@ Done before generating the new subject of a forward."
620 620
621(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" 621(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
622 "All headers that match this regexp will be deleted when forwarding a message. 622 "All headers that match this regexp will be deleted when forwarding a message.
623This variable is only consulted when forwarding \"normally\", not 623This variable is not consulted when forwarding encrypted messages
624when forwarding as MIME or the like. 624and `message-forward-show-mml' is `best'.
625 625
626This may also be a list of regexps." 626This may also be a list of regexps."
627 :version "21.1" 627 :version "21.1"
@@ -7638,7 +7638,8 @@ Optional DIGEST will use digest to forward."
7638 message-forward-included-headers) 7638 message-forward-included-headers)
7639 t nil t))))) 7639 t nil t)))))
7640 7640
7641(defun message-forward-make-body-mime (forward-buffer &optional beg end) 7641(defun message-forward-make-body-mime (forward-buffer &optional beg end
7642 remove-headers)
7642 (let ((b (point))) 7643 (let ((b (point)))
7643 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") 7644 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
7644 (save-restriction 7645 (save-restriction
@@ -7648,6 +7649,8 @@ Optional DIGEST will use digest to forward."
7648 (goto-char (point-min)) 7649 (goto-char (point-min))
7649 (when (looking-at "From ") 7650 (when (looking-at "From ")
7650 (replace-match "X-From-Line: ")) 7651 (replace-match "X-From-Line: "))
7652 (when remove-headers
7653 (message-remove-ignored-headers (point-min) (point-max)))
7651 (goto-char (point-max))) 7654 (goto-char (point-max)))
7652 (insert "<#/part>\n") 7655 (insert "<#/part>\n")
7653 ;; Consider there is no illegible text. 7656 ;; Consider there is no illegible text.
@@ -7786,7 +7789,8 @@ is for the internal use."
7786 (message-signed-or-encrypted-p) 7789 (message-signed-or-encrypted-p)
7787 (error t)))))) 7790 (error t))))))
7788 (message-forward-make-body-mml forward-buffer) 7791 (message-forward-make-body-mml forward-buffer)
7789 (message-forward-make-body-mime forward-buffer)) 7792 (message-forward-make-body-mime
7793 forward-buffer nil nil (not (eq message-forward-show-mml 'best))))
7790 (message-forward-make-body-plain forward-buffer))) 7794 (message-forward-make-body-plain forward-buffer)))
7791 (message-position-point)) 7795 (message-position-point))
7792 7796
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 2b0b61bfac6..61946aa5811 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1264,20 +1264,11 @@ in HANDLE."
1264 (when (and (mm-handle-buffer handle) 1264 (when (and (mm-handle-buffer handle)
1265 (buffer-name (mm-handle-buffer handle))) 1265 (buffer-name (mm-handle-buffer handle)))
1266 (with-temp-buffer 1266 (with-temp-buffer
1267 (if (and (eq (mm-handle-encoding handle) '8bit) 1267 (mm-disable-multibyte)
1268 (with-current-buffer (mm-handle-buffer handle) 1268 (insert-buffer-substring (mm-handle-buffer handle))
1269 enable-multibyte-characters)) 1269 (mm-decode-content-transfer-encoding
1270 ;; Due to unfortunate historical reasons, we may have a 1270 (mm-handle-encoding handle)
1271 ;; multibyte buffer here, but if it's using an 8bit 1271 (mm-handle-media-type handle))
1272 ;; Content-Transfer-Encoding, then work around that by
1273 ;; just ignoring the situation.
1274 (insert-buffer-substring (mm-handle-buffer handle))
1275 ;; Do the decoding.
1276 (mm-disable-multibyte)
1277 (insert-buffer-substring (mm-handle-buffer handle))
1278 (mm-decode-content-transfer-encoding
1279 (mm-handle-encoding handle)
1280 (mm-handle-media-type handle)))
1281 ,@forms)))) 1272 ,@forms))))
1282(put 'mm-with-part 'lisp-indent-function 1) 1273(put 'mm-with-part 'lisp-indent-function 1)
1283(put 'mm-with-part 'edebug-form-spec '(body)) 1274(put 'mm-with-part 'edebug-form-spec '(body))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index e4fd976742c..2a4c74db5e8 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.")
1351 (throw 'return nil)) 1351 (throw 'return nil))
1352 (with-current-buffer (or to-buffer nntp-server-buffer) 1352 (with-current-buffer (or to-buffer nntp-server-buffer)
1353 (erase-buffer) 1353 (erase-buffer)
1354 (nnheader-insert-file-contents nnmaildir-article-file-name)) 1354 (let ((coding-system-for-read mm-text-coding-system))
1355 (mm-insert-file-contents nnmaildir-article-file-name)))
1355 (cons gname num-msgid)))) 1356 (cons gname num-msgid))))
1356 1357
1357(defun nnmaildir-request-post (&optional _server) 1358(defun nnmaildir-request-post (&optional _server)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index b6feeebf038..8ce936ad164 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -713,7 +713,9 @@ FILE is the file where FUNCTION was probably defined."
713 (insert-text-button 713 (insert-text-button
714 (symbol-name group) 714 (symbol-name group)
715 'action (lambda (_) 715 'action (lambda (_)
716 (shortdoc-display-group group)))) 716 (shortdoc-display-group group))
717 'follow-link t
718 'help-echo (purecopy "mouse-1, RET: show documentation group")))
717 groups) 719 groups)
718 (insert (if (= (length groups) 1) 720 (insert (if (= (length groups) 1)
719 " group.\n" 721 " group.\n"
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index cd08b2b2ba4..7043f12c9a3 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -357,8 +357,7 @@ Commands:
357 "\\(symbol\\|program\\|property\\)\\|" ; Don't link 357 "\\(symbol\\|program\\|property\\)\\|" ; Don't link
358 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" 358 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
359 "[ \t\n]+\\)?" 359 "[ \t\n]+\\)?"
360 ;; Note starting with word-syntax character: 360 "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]"))
361 "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
362 "Regexp matching doc string references to symbols. 361 "Regexp matching doc string references to symbols.
363 362
364The words preceding the quoted symbol can be used in doc strings to 363The words preceding the quoted symbol can be used in doc strings to
diff --git a/lisp/info.el b/lisp/info.el
index 62d7b583ff2..dec93928b38 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1973,7 +1973,6 @@ If DIRECTION is `backward', search in the reverse direction."
1973 "Regexp search%s" (car Info-search-history) 1973 "Regexp search%s" (car Info-search-history)
1974 (if case-fold-search "" " case-sensitively")) 1974 (if case-fold-search "" " case-sensitively"))
1975 nil 'Info-search-history))) 1975 nil 'Info-search-history)))
1976 (deactivate-mark)
1977 (when (equal regexp "") 1976 (when (equal regexp "")
1978 (setq regexp (car Info-search-history))) 1977 (setq regexp (car Info-search-history)))
1979 (when regexp 1978 (when regexp
@@ -2066,6 +2065,7 @@ If DIRECTION is `backward', search in the reverse direction."
2066 (< found opoint-max)) 2065 (< found opoint-max))
2067 ;; Search landed in the same node 2066 ;; Search landed in the same node
2068 (goto-char found) 2067 (goto-char found)
2068 (deactivate-mark)
2069 (widen) 2069 (widen)
2070 (goto-char found) 2070 (goto-char found)
2071 (save-match-data (Info-select-node))) 2071 (save-match-data (Info-select-node)))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 67cc7bed15b..c6f7fe7bd4a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -838,10 +838,6 @@ This is like `describe-bindings', but displays only Isearch keys."
838 :image '(isearch-tool-bar-image "left-arrow"))) 838 :image '(isearch-tool-bar-image "left-arrow")))
839 map)) 839 map))
840 840
841;; Note: Before adding more key bindings to this map, please keep in
842;; mind that any unbound key exits Isearch and runs the command bound
843;; to it in the local or global map. So in effect every key unbound
844;; in this map is implicitly bound.
845(defvar minibuffer-local-isearch-map 841(defvar minibuffer-local-isearch-map
846 (let ((map (make-sparse-keymap))) 842 (let ((map (make-sparse-keymap)))
847 (set-keymap-parent map minibuffer-local-map) 843 (set-keymap-parent map minibuffer-local-map)
@@ -2498,6 +2494,21 @@ If search string is empty, just beep."
2498 (unless isearch-mode (isearch-mode t)) 2494 (unless isearch-mode (isearch-mode t))
2499 (isearch-yank-string (current-kill 0))) 2495 (isearch-yank-string (current-kill 0)))
2500 2496
2497(defun isearch-yank-from-kill-ring ()
2498 "Read a string from the `kill-ring' and append it to the search string."
2499 (interactive)
2500 (with-isearch-suspended
2501 (let ((string (read-from-kill-ring)))
2502 (if (and isearch-case-fold-search
2503 (eq 'not-yanks search-upper-case))
2504 (setq string (downcase string)))
2505 (if isearch-regexp (setq string (regexp-quote string)))
2506 (setq isearch-yank-flag t)
2507 (setq isearch-new-string (concat isearch-string string)
2508 isearch-new-message (concat isearch-message
2509 (mapconcat 'isearch-text-char-description
2510 string ""))))))
2511
2501(defun isearch-yank-pop () 2512(defun isearch-yank-pop ()
2502 "Replace just-yanked search string with previously killed string. 2513 "Replace just-yanked search string with previously killed string.
2503Unlike `isearch-yank-pop-only', when this command is called not immediately 2514Unlike `isearch-yank-pop-only', when this command is called not immediately
@@ -2506,37 +2517,31 @@ minibuffer to read a string from the `kill-ring' as `yank-pop' does."
2506 (interactive) 2517 (interactive)
2507 (if (not (memq last-command '(isearch-yank-kill 2518 (if (not (memq last-command '(isearch-yank-kill
2508 isearch-yank-pop isearch-yank-pop-only))) 2519 isearch-yank-pop isearch-yank-pop-only)))
2509 ;; Yank string from kill-ring-browser. 2520 (isearch-yank-from-kill-ring)
2510 (with-isearch-suspended
2511 (let ((string (read-from-kill-ring)))
2512 (if (and isearch-case-fold-search
2513 (eq 'not-yanks search-upper-case))
2514 (setq string (downcase string)))
2515 (if isearch-regexp (setq string (regexp-quote string)))
2516 (setq isearch-yank-flag t)
2517 (setq isearch-new-string (concat isearch-string string)
2518 isearch-new-message (concat isearch-message
2519 (mapconcat 'isearch-text-char-description
2520 string "")))))
2521 (isearch-pop-state) 2521 (isearch-pop-state)
2522 (isearch-yank-string (current-kill 1)))) 2522 (isearch-yank-string (current-kill 1))))
2523 2523
2524(defun isearch-yank-pop-only () 2524(defun isearch-yank-pop-only (&optional arg)
2525 "Replace just-yanked search string with previously killed string. 2525 "Replace just-yanked search string with previously killed string.
2526Unlike `isearch-yank-pop', when this command is called not immediately 2526Unlike `isearch-yank-pop', when this command is called not immediately
2527after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops 2527after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops
2528the last killed string instead of activating the minibuffer to read 2528the last killed string instead of activating the minibuffer to read
2529a string from the `kill-ring' as `yank-pop' does." 2529a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u
2530 (interactive) 2530always reads a string from the `kill-ring' using the minibuffer."
2531 (if (not (memq last-command '(isearch-yank-kill 2531 (interactive "P")
2532 isearch-yank-pop isearch-yank-pop-only))) 2532 (cond
2533 ;; Fall back on `isearch-yank-kill' for the benefits of people 2533 ((equal arg '(4))
2534 ;; who are used to the old behavior of `M-y' in isearch mode. 2534 (isearch-yank-from-kill-ring))
2535 ;; In future, `M-y' could be changed from `isearch-yank-pop-only' 2535 ((not (memq last-command '(isearch-yank-kill
2536 ;; to `isearch-yank-pop' that uses the kill-ring-browser. 2536 isearch-yank-pop isearch-yank-pop-only)))
2537 (isearch-yank-kill) 2537 ;; Fall back on `isearch-yank-kill' for the benefits of people
2538 ;; who are used to the old behavior of `M-y' in isearch mode.
2539 ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
2540 ;; to `isearch-yank-pop' that uses the kill-ring-browser.
2541 (isearch-yank-kill))
2542 (t
2538 (isearch-pop-state) 2543 (isearch-pop-state)
2539 (isearch-yank-string (current-kill 1)))) 2544 (isearch-yank-string (current-kill 1)))))
2540 2545
2541(defun isearch-yank-x-selection () 2546(defun isearch-yank-x-selection ()
2542 "Pull current X selection into search string." 2547 "Pull current X selection into search string."
@@ -2997,7 +3002,7 @@ See more for options in `search-exit-option'."
2997 ((and (eq (car-safe main-event) 'down-mouse-1) 3002 ((and (eq (car-safe main-event) 'down-mouse-1)
2998 (window-minibuffer-p (posn-window (event-start main-event)))) 3003 (window-minibuffer-p (posn-window (event-start main-event))))
2999 ;; Swallow the up-event. 3004 ;; Swallow the up-event.
3000 (read-event) 3005 (read--potential-mouse-event)
3001 (setq this-command 'isearch-edit-string)) 3006 (setq this-command 'isearch-edit-string))
3002 ;; Don't terminate the search for motion commands. 3007 ;; Don't terminate the search for motion commands.
3003 ((and isearch-yank-on-move 3008 ((and isearch-yank-on-move
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 556f5d3a564..315f2d369af 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2125,8 +2125,10 @@ variables.")
2125 ;; A better solution would be to make deactivate-mark buffer-local 2125 ;; A better solution would be to make deactivate-mark buffer-local
2126 ;; (or to turn it into a list of buffers, ...), but in the mean time, 2126 ;; (or to turn it into a list of buffers, ...), but in the mean time,
2127 ;; this should do the trick in most cases. 2127 ;; this should do the trick in most cases.
2128 (setq deactivate-mark nil) 2128 (when (innermost-minibuffer-p)
2129 (throw 'exit nil)) 2129 (setq deactivate-mark nil)
2130 (throw 'exit nil))
2131 (error "%s" "Not in most nested minibuffer"))
2130 2132
2131(defun self-insert-and-exit () 2133(defun self-insert-and-exit ()
2132 "Terminate minibuffer input." 2134 "Terminate minibuffer input."
@@ -2394,7 +2396,7 @@ The completion method is determined by `completion-at-point-functions'."
2394;;; Key bindings. 2396;;; Key bindings.
2395 2397
2396(let ((map minibuffer-local-map)) 2398(let ((map minibuffer-local-map))
2397 (define-key map "\C-g" 'abort-recursive-edit) 2399 (define-key map "\C-g" 'abort-minibuffers)
2398 (define-key map "\M-<" 'minibuffer-beginning-of-buffer) 2400 (define-key map "\M-<" 'minibuffer-beginning-of-buffer)
2399 2401
2400 (define-key map "\r" 'exit-minibuffer) 2402 (define-key map "\r" 'exit-minibuffer)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index f6612600bdd..907ef061594 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -225,7 +225,7 @@ To test this function, evaluate:
225 ;; Don't change the mouse pointer shape while we drag. 225 ;; Don't change the mouse pointer shape while we drag.
226 (setq track-mouse 'dragging) 226 (setq track-mouse 'dragging)
227 (while (progn 227 (while (progn
228 (setq event (read-event) 228 (setq event (read--potential-mouse-event)
229 end (event-end event) 229 end (event-end event)
230 row (cdr (posn-col-row end)) 230 row (cdr (posn-col-row end))
231 col (car (posn-col-row end))) 231 col (car (posn-col-row end)))
@@ -286,7 +286,7 @@ To test this function, evaluate:
286 window-last-col (- (window-width) 2)) 286 window-last-col (- (window-width) 2))
287 (track-mouse 287 (track-mouse
288 (while (progn 288 (while (progn
289 (setq event (read-event) 289 (setq event (read--potential-mouse-event)
290 end (event-end event) 290 end (event-end event)
291 row (cdr (posn-col-row end)) 291 row (cdr (posn-col-row end))
292 col (car (posn-col-row end))) 292 col (car (posn-col-row end)))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0da82882fc1..8732fb80866 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1792,7 +1792,7 @@ The function returns a non-nil value if it creates a secondary selection."
1792 (let (event end end-point) 1792 (let (event end end-point)
1793 (track-mouse 1793 (track-mouse
1794 (while (progn 1794 (while (progn
1795 (setq event (read-event)) 1795 (setq event (read--potential-mouse-event))
1796 (or (mouse-movement-p event) 1796 (or (mouse-movement-p event)
1797 (memq (car-safe event) '(switch-frame select-window)))) 1797 (memq (car-safe event) '(switch-frame select-window))))
1798 1798
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 3f3e7133713..0ce65a35ead 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -239,7 +239,7 @@ otherwise."
239 (mapc 239 (mapc
240 (lambda (info) 240 (lambda (info)
241 (let ((local-ip (nth 1 info)) 241 (let ((local-ip (nth 1 info))
242 (mask (nth 2 info))) 242 (mask (nth 3 info)))
243 (when 243 (when
244 (nsm-network-same-subnet (substring local-ip 0 -1) 244 (nsm-network-same-subnet (substring local-ip 0 -1)
245 (substring mask 0 -1) 245 (substring mask 0 -1)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c0c215de877..2c4ef2acaef 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -98,6 +98,7 @@ It is used for TCP/IP devices."
98 `(,tramp-adb-method 98 `(,tramp-adb-method
99 (tramp-login-program ,tramp-adb-program) 99 (tramp-login-program ,tramp-adb-program)
100 (tramp-login-args (("shell"))) 100 (tramp-login-args (("shell")))
101 (tramp-direct-async t)
101 (tramp-tmpdir "/data/local/tmp") 102 (tramp-tmpdir "/data/local/tmp")
102 (tramp-default-port 5555))) 103 (tramp-default-port 5555)))
103 104
@@ -895,8 +896,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
895;; terminated. 896;; terminated.
896(defun tramp-adb-handle-make-process (&rest args) 897(defun tramp-adb-handle-make-process (&rest args)
897 "Like `make-process' for Tramp files. 898 "Like `make-process' for Tramp files.
898If connection property \"direct-async-process\" is non-nil, an 899If method parameter `tramp-direct-async' and connection property
899alternative implementation will be used." 900\"direct-async-process\" are non-nil, an alternative
901implementation will be used."
900 (if (tramp-direct-async-process-p args) 902 (if (tramp-direct-async-process-p args)
901 (apply #'tramp-handle-make-process args) 903 (apply #'tramp-handle-make-process args)
902 (when args 904 (when args
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b43b4485fec..e8ee372cb25 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -168,6 +168,7 @@ The string is used in `tramp-methods'.")
168 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 168 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
169 ("-e" "none") ("%h"))) 169 ("-e" "none") ("%h")))
170 (tramp-async-args (("-q"))) 170 (tramp-async-args (("-q")))
171 (tramp-direct-async t)
171 (tramp-remote-shell ,tramp-default-remote-shell) 172 (tramp-remote-shell ,tramp-default-remote-shell)
172 (tramp-remote-shell-login ("-l")) 173 (tramp-remote-shell-login ("-l"))
173 (tramp-remote-shell-args ("-c")) 174 (tramp-remote-shell-args ("-c"))
@@ -183,6 +184,7 @@ The string is used in `tramp-methods'.")
183 ("-e" "none") ("-t" "-t") ("%h") 184 ("-e" "none") ("-t" "-t") ("%h")
184 ("%l"))) 185 ("%l")))
185 (tramp-async-args (("-q"))) 186 (tramp-async-args (("-q")))
187 (tramp-direct-async t)
186 (tramp-remote-shell ,tramp-default-remote-shell) 188 (tramp-remote-shell ,tramp-default-remote-shell)
187 (tramp-remote-shell-login ("-l")) 189 (tramp-remote-shell-login ("-l"))
188 (tramp-remote-shell-args ("-c")) 190 (tramp-remote-shell-args ("-c"))
@@ -197,6 +199,7 @@ The string is used in `tramp-methods'.")
197 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 199 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
198 ("-e" "none") ("%h"))) 200 ("-e" "none") ("%h")))
199 (tramp-async-args (("-q"))) 201 (tramp-async-args (("-q")))
202 (tramp-direct-async t)
200 (tramp-remote-shell ,tramp-default-remote-shell) 203 (tramp-remote-shell ,tramp-default-remote-shell)
201 (tramp-remote-shell-login ("-l")) 204 (tramp-remote-shell-login ("-l"))
202 (tramp-remote-shell-args ("-c")) 205 (tramp-remote-shell-args ("-c"))
@@ -227,6 +230,7 @@ The string is used in `tramp-methods'.")
227 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 230 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
228 ("-e" "none") ("%h"))) 231 ("-e" "none") ("%h")))
229 (tramp-async-args (("-q"))) 232 (tramp-async-args (("-q")))
233 (tramp-direct-async t)
230 (tramp-remote-shell ,tramp-default-remote-shell) 234 (tramp-remote-shell ,tramp-default-remote-shell)
231 (tramp-remote-shell-login ("-l")) 235 (tramp-remote-shell-login ("-l"))
232 (tramp-remote-shell-args ("-c")))) 236 (tramp-remote-shell-args ("-c"))))
@@ -237,6 +241,7 @@ The string is used in `tramp-methods'.")
237 ("-e" "none") ("-t" "-t") ("%h") 241 ("-e" "none") ("-t" "-t") ("%h")
238 ("%l"))) 242 ("%l")))
239 (tramp-async-args (("-q"))) 243 (tramp-async-args (("-q")))
244 (tramp-direct-async t)
240 (tramp-remote-shell ,tramp-default-remote-shell) 245 (tramp-remote-shell ,tramp-default-remote-shell)
241 (tramp-remote-shell-login ("-l")) 246 (tramp-remote-shell-login ("-l"))
242 (tramp-remote-shell-args ("-c")))) 247 (tramp-remote-shell-args ("-c"))))
@@ -2601,7 +2606,7 @@ The method used must be an out-of-band method."
2601 (t nil))))))))) 2606 (t nil)))))))))
2602 2607
2603(defun tramp-sh-handle-insert-directory 2608(defun tramp-sh-handle-insert-directory
2604 (filename switches &optional wildcard full-directory-p) 2609 (filename switches &optional wildcard full-directory-p)
2605 "Like `insert-directory' for Tramp files." 2610 "Like `insert-directory' for Tramp files."
2606 (setq filename (expand-file-name filename)) 2611 (setq filename (expand-file-name filename))
2607 (unless switches (setq switches "")) 2612 (unless switches (setq switches ""))
@@ -2636,66 +2641,63 @@ The method used must be an out-of-band method."
2636 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" 2641 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
2637 switches filename (if wildcard "yes" "no") 2642 switches filename (if wildcard "yes" "no")
2638 (if full-directory-p "yes" "no")) 2643 (if full-directory-p "yes" "no"))
2639 ;; If `full-directory-p', we just say `ls -l FILENAME'. 2644 ;; If `full-directory-p', we just say `ls -l FILENAME'. Else we
2640 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. 2645 ;; chdir to the parent directory, then say `ls -ld BASENAME'.
2641 (if full-directory-p 2646 (if full-directory-p
2642 (tramp-send-command 2647 (tramp-send-command
2643 v 2648 v (format "%s %s %s 2>%s"
2644 (format "%s %s %s 2>%s" 2649 (tramp-get-ls-command v)
2645 (tramp-get-ls-command v) 2650 switches
2646 switches 2651 (if wildcard
2647 (if wildcard 2652 localname
2648 localname 2653 (tramp-shell-quote-argument (concat localname ".")))
2649 (tramp-shell-quote-argument (concat localname "."))) 2654 (tramp-get-remote-null-device v)))
2650 (tramp-get-remote-null-device v)))
2651 (tramp-barf-unless-okay 2655 (tramp-barf-unless-okay
2652 v 2656 v (format "cd %s" (tramp-shell-quote-argument
2653 (format "cd %s" (tramp-shell-quote-argument 2657 (tramp-run-real-handler
2654 (tramp-run-real-handler 2658 #'file-name-directory (list localname))))
2655 #'file-name-directory (list localname))))
2656 "Couldn't `cd %s'" 2659 "Couldn't `cd %s'"
2657 (tramp-shell-quote-argument 2660 (tramp-shell-quote-argument
2658 (tramp-run-real-handler #'file-name-directory (list localname)))) 2661 (tramp-run-real-handler #'file-name-directory (list localname))))
2659 (tramp-send-command 2662 (tramp-send-command
2660 v 2663 v (format "%s %s %s 2>%s"
2661 (format "%s %s %s 2>%s" 2664 (tramp-get-ls-command v)
2662 (tramp-get-ls-command v) 2665 switches
2663 switches 2666 (if (or wildcard
2664 (if (or wildcard 2667 (zerop (length
2665 (zerop (length 2668 (tramp-run-real-handler
2666 (tramp-run-real-handler 2669 #'file-name-nondirectory (list localname)))))
2667 #'file-name-nondirectory (list localname))))) 2670 ""
2668 "" 2671 (tramp-shell-quote-argument
2669 (tramp-shell-quote-argument 2672 (tramp-run-real-handler
2670 (tramp-run-real-handler 2673 #'file-name-nondirectory (list localname))))
2671 #'file-name-nondirectory (list localname)))) 2674 (tramp-get-remote-null-device v))))
2672 (tramp-get-remote-null-device v)))) 2675
2673 2676 (let ((beg-marker (copy-marker (point) nil))
2674 (save-restriction 2677 (end-marker (copy-marker (point) t))
2675 (let ((beg (point)) 2678 (emc enable-multibyte-characters))
2676 (emc enable-multibyte-characters)) 2679 ;; We cannot use `insert-buffer-substring' because the Tramp
2677 (narrow-to-region (point) (point)) 2680 ;; buffer changes its contents before insertion due to calling
2678 ;; We cannot use `insert-buffer-substring' because the Tramp 2681 ;; `expand-file-name' and alike.
2679 ;; buffer changes its contents before insertion due to calling 2682 (insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
2680 ;; `expand-file-name' and alike. 2683
2681 (insert 2684 ;; We must enable unibyte strings, because the "--dired"
2682 (with-current-buffer (tramp-get-buffer v) 2685 ;; output counts in bytes.
2683 (buffer-string))) 2686 (set-buffer-multibyte nil)
2684 2687 (save-restriction
2685 ;; Check for "--dired" output. We must enable unibyte 2688 (narrow-to-region beg-marker end-marker)
2686 ;; strings, because the "--dired" output counts in bytes. 2689 ;; Check for "--dired" output.
2687 (set-buffer-multibyte nil)
2688 (forward-line -2) 2690 (forward-line -2)
2689 (when (looking-at-p "//SUBDIRED//") 2691 (when (looking-at-p "//SUBDIRED//")
2690 (forward-line -1)) 2692 (forward-line -1))
2691 (when (looking-at "//DIRED//\\s-+") 2693 (when (looking-at "//DIRED//\\s-+")
2692 (let ((databeg (match-end 0)) 2694 (let ((beg (match-end 0))
2693 (end (point-at-eol))) 2695 (end (point-at-eol)))
2694 ;; Now read the numeric positions of file names. 2696 ;; Now read the numeric positions of file names.
2695 (goto-char databeg) 2697 (goto-char beg)
2696 (while (< (point) end) 2698 (while (< (point) end)
2697 (let ((start (+ beg (read (current-buffer)))) 2699 (let ((start (+ (point-min) (read (current-buffer))))
2698 (end (+ beg (read (current-buffer))))) 2700 (end (+ (point-min) (read (current-buffer)))))
2699 (if (memq (char-after end) '(?\n ?\ )) 2701 (if (memq (char-after end) '(?\n ?\ ))
2700 ;; End is followed by \n or by " -> ". 2702 ;; End is followed by \n or by " -> ".
2701 (put-text-property start end 'dired-filename t)))))) 2703 (put-text-property start end 'dired-filename t))))))
@@ -2703,18 +2705,18 @@ The method used must be an out-of-band method."
2703 (goto-char (point-at-bol)) 2705 (goto-char (point-at-bol))
2704 (while (looking-at "//") 2706 (while (looking-at "//")
2705 (forward-line 1) 2707 (forward-line 1)
2706 (delete-region (match-beginning 0) (point))) 2708 (delete-region (match-beginning 0) (point))))
2707 ;; Reset multibyte if needed. 2709 ;; Reset multibyte if needed.
2708 (set-buffer-multibyte emc) 2710 (set-buffer-multibyte emc)
2709 2711
2712 (save-restriction
2713 (narrow-to-region beg-marker end-marker)
2710 ;; Some busyboxes are reluctant to discard colors. 2714 ;; Some busyboxes are reluctant to discard colors.
2711 (unless 2715 (unless
2712 (string-match-p "color" (tramp-get-connection-property v "ls" "")) 2716 (string-match-p "color" (tramp-get-connection-property v "ls" ""))
2713 (save-excursion 2717 (goto-char (point-min))
2714 (goto-char beg) 2718 (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
2715 (while 2719 (replace-match "")))
2716 (re-search-forward tramp-display-escape-sequence-regexp nil t)
2717 (replace-match ""))))
2718 2720
2719 ;; Now decode what read if necessary. Stolen from `insert-directory'. 2721 ;; Now decode what read if necessary. Stolen from `insert-directory'.
2720 (let ((coding (or coding-system-for-read 2722 (let ((coding (or coding-system-for-read
@@ -2729,36 +2731,32 @@ The method used must be an out-of-band method."
2729 ;; If no coding system is specified or detection is 2731 ;; If no coding system is specified or detection is
2730 ;; requested, detect the coding. 2732 ;; requested, detect the coding.
2731 (if (eq (coding-system-base coding) 'undecided) 2733 (if (eq (coding-system-base coding) 'undecided)
2732 (setq coding (detect-coding-region beg (point) t))) 2734 (setq coding (detect-coding-region (point-min) (point) t)))
2733 (if (not (eq (coding-system-base coding) 'undecided)) 2735 (unless (eq (coding-system-base coding) 'undecided)
2734 (save-restriction 2736 (setq coding-no-eol
2735 (setq coding-no-eol 2737 (coding-system-change-eol-conversion coding 'unix))
2736 (coding-system-change-eol-conversion coding 'unix)) 2738 (goto-char (point-min))
2737 (narrow-to-region beg (point)) 2739 (while (not (eobp))
2738 (goto-char (point-min)) 2740 (setq pos (point)
2739 (while (not (eobp)) 2741 val (get-text-property (point) 'dired-filename))
2740 (setq pos (point) 2742 (goto-char (next-single-property-change
2741 val (get-text-property (point) 'dired-filename)) 2743 (point) 'dired-filename nil (point-max)))
2742 (goto-char (next-single-property-change 2744 ;; Force no eol conversion on a file name, so that
2743 (point) 'dired-filename nil (point-max))) 2745 ;; CR is preserved.
2744 ;; Force no eol conversion on a file name, so 2746 (decode-coding-region
2745 ;; that CR is preserved. 2747 pos (point) (if val coding-no-eol coding))
2746 (decode-coding-region pos (point) 2748 (if val (put-text-property pos (point) 'dired-filename t))))))
2747 (if val coding-no-eol coding))
2748 (if val
2749 (put-text-property pos (point)
2750 'dired-filename t)))))))
2751 2749
2752 ;; The inserted file could be from somewhere else. 2750 ;; The inserted file could be from somewhere else.
2753 (when (and (not wildcard) (not full-directory-p)) 2751 (when (and (not wildcard) (not full-directory-p))
2754 (goto-char (point-max)) 2752 (goto-char (point-max))
2755 (when (file-symlink-p filename) 2753 (when (file-symlink-p filename)
2756 (goto-char (search-backward "->" beg 'noerror))) 2754 (goto-char (search-backward "->" (point-min) 'noerror)))
2757 (search-backward 2755 (search-backward
2758 (if (directory-name-p filename) 2756 (if (directory-name-p filename)
2759 "." 2757 "."
2760 (file-name-nondirectory filename)) 2758 (file-name-nondirectory filename))
2761 beg 'noerror) 2759 (point-min) 'noerror)
2762 (replace-match (file-relative-name filename) t)) 2760 (replace-match (file-relative-name filename) t))
2763 2761
2764 ;; Try to insert the amount of free space. 2762 ;; Try to insert the amount of free space.
@@ -2769,9 +2767,11 @@ The method used must be an out-of-band method."
2769 ;; Replace "total" with "total used", to avoid confusion. 2767 ;; Replace "total" with "total used", to avoid confusion.
2770 (replace-match "\\1 used in directory") 2768 (replace-match "\\1 used in directory")
2771 (end-of-line) 2769 (end-of-line)
2772 (insert " available " available))) 2770 (insert " available " available))))
2773 2771
2774 (goto-char (point-max))))))) 2772 (prog1 (goto-char end-marker)
2773 (set-marker beg-marker nil)
2774 (set-marker end-marker nil))))))
2775 2775
2776;; Canonicalization of file names. 2776;; Canonicalization of file names.
2777 2777
@@ -2840,9 +2840,9 @@ the result will be a local, non-Tramp, file name."
2840;; terminated. 2840;; terminated.
2841(defun tramp-sh-handle-make-process (&rest args) 2841(defun tramp-sh-handle-make-process (&rest args)
2842 "Like `make-process' for Tramp files. 2842 "Like `make-process' for Tramp files.
2843STDERR can also be a file name. If connection property 2843STDERR can also be a file name. If method parameter `tramp-direct-async'
2844\"direct-async-process\" is non-nil, an alternative 2844and connection property \"direct-async-process\" are non-nil, an
2845implementation will be used." 2845alternative implementation will be used."
2846 (if (tramp-direct-async-process-p args) 2846 (if (tramp-direct-async-process-p args)
2847 (apply #'tramp-handle-make-process args) 2847 (apply #'tramp-handle-make-process args)
2848 (when args 2848 (when args
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cc8dda809e2..2816c58fe7f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -259,9 +259,9 @@ pair of the form (KEY VALUE). The following KEYs are defined:
259 parameters to suppress diagnostic messages, in order not to 259 parameters to suppress diagnostic messages, in order not to
260 tamper the process output. 260 tamper the process output.
261 261
262 * `tramp-direct-async-args' 262 * `tramp-direct-async'
263 An additional argument when a direct asynchronous process is 263 Whether the method supports direct asynchronous processes.
264 started. Used so far only in the \"mock\" method of tramp-tests.el. 264 Until now, just \"ssh\"-based and \"adb\"-based methods do.
265 265
266 * `tramp-copy-program' 266 * `tramp-copy-program'
267 This specifies the name of the program to use for remotely copying 267 This specifies the name of the program to use for remotely copying
@@ -1755,7 +1755,8 @@ The outline level is equal to the verbosity of the Tramp message."
1755Message is formatted with FMT-STRING as control string and the remaining 1755Message is formatted with FMT-STRING as control string and the remaining
1756ARGUMENTS to actually emit the message (if applicable)." 1756ARGUMENTS to actually emit the message (if applicable)."
1757 (let ((inhibit-message t) 1757 (let ((inhibit-message t)
1758 file-name-handler-alist message-log-max signal-hook-function) 1758 create-lockfiles file-name-handler-alist message-log-max
1759 signal-hook-function)
1759 (with-current-buffer (tramp-get-debug-buffer vec) 1760 (with-current-buffer (tramp-get-debug-buffer vec)
1760 (goto-char (point-max)) 1761 (goto-char (point-max))
1761 (let ((point (point))) 1762 (let ((point (point)))
@@ -1982,6 +1983,13 @@ the resulting error message."
1982 1983
1983(put #'tramp-with-demoted-errors 'tramp-suppress-trace t) 1984(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
1984 1985
1986(defun tramp-test-message (fmt-string &rest arguments)
1987 "Emit a Tramp message according `default-directory'."
1988 (if (tramp-tramp-file-p default-directory)
1989 (apply #'tramp-message
1990 (tramp-dissect-file-name default-directory) 0 fmt-string arguments)
1991 (apply #'message fmt-string arguments)))
1992
1985;; This function provides traces in case of errors not triggered by 1993;; This function provides traces in case of errors not triggered by
1986;; Tramp functions. 1994;; Tramp functions.
1987(defun tramp-signal-hook-function (error-symbol data) 1995(defun tramp-signal-hook-function (error-symbol data)
@@ -3741,7 +3749,9 @@ User is always nil."
3741 (let ((v (tramp-dissect-file-name default-directory)) 3749 (let ((v (tramp-dissect-file-name default-directory))
3742 (buffer (plist-get args :buffer)) 3750 (buffer (plist-get args :buffer))
3743 (stderr (plist-get args :stderr))) 3751 (stderr (plist-get args :stderr)))
3744 (and ;; It has been indicated. 3752 (and ;; The method supports it.
3753 (tramp-get-method-parameter v 'tramp-direct-async)
3754 ;; It has been indicated.
3745 (tramp-get-connection-property v "direct-async-process" nil) 3755 (tramp-get-connection-property v "direct-async-process" nil)
3746 ;; There's no multi-hop. 3756 ;; There's no multi-hop.
3747 (or (not (tramp-multi-hop-p v)) 3757 (or (not (tramp-multi-hop-p v))
@@ -3821,8 +3831,6 @@ It does not support `:stderr'."
3821 (tramp-get-method-parameter v 'tramp-login-args)) 3831 (tramp-get-method-parameter v 'tramp-login-args))
3822 (async-args 3832 (async-args
3823 (tramp-get-method-parameter v 'tramp-async-args)) 3833 (tramp-get-method-parameter v 'tramp-async-args))
3824 (direct-async-args
3825 (tramp-get-method-parameter v 'tramp-direct-async-args))
3826 ;; We don't create the temporary file. In fact, it 3834 ;; We don't create the temporary file. In fact, it
3827 ;; is just a prefix for the ControlPath option of 3835 ;; is just a prefix for the ControlPath option of
3828 ;; ssh; the real temporary file has another name, and 3836 ;; ssh; the real temporary file has another name, and
@@ -3850,7 +3858,7 @@ It does not support `:stderr'."
3850 ?h (or host "") ?u (or user "") ?p (or port "") 3858 ?h (or host "") ?u (or user "") ?p (or port "")
3851 ?c options ?l "") 3859 ?c options ?l "")
3852 ;; Add arguments for asynchronous processes. 3860 ;; Add arguments for asynchronous processes.
3853 login-args (append async-args direct-async-args login-args) 3861 login-args (append async-args login-args)
3854 ;; Expand format spec. 3862 ;; Expand format spec.
3855 login-args 3863 login-args
3856 (tramp-compat-flatten-tree 3864 (tramp-compat-flatten-tree
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 714b3f9bb01..ced3e93fc09 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
7;; Maintainer: Michael Albinus <michael.albinus@gmx.de> 7;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
8;; Keywords: comm, processes 8;; Keywords: comm, processes
9;; Package: tramp 9;; Package: tramp
10;; Version: 2.5.0 10;; Version: 2.5.1-pre
11;; Package-Requires: ((emacs "25.1")) 11;; Package-Requires: ((emacs "25.1"))
12;; Package-Type: multi 12;; Package-Type: multi
13;; URL: https://www.gnu.org/software/tramp/ 13;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
40;; ./configure" to change them. 40;; ./configure" to change them.
41 41
42;;;###tramp-autoload 42;;;###tramp-autoload
43(defconst tramp-version "2.5.0" 43(defconst tramp-version "2.5.1-pre"
44 "This version of Tramp.") 44 "This version of Tramp.")
45 45
46;;;###tramp-autoload 46;;;###tramp-autoload
@@ -76,7 +76,7 @@
76;; Check for Emacs version. 76;; Check for Emacs version.
77(let ((x (if (not (string-lessp emacs-version "25.1")) 77(let ((x (if (not (string-lessp emacs-version "25.1"))
78 "ok" 78 "ok"
79 (format "Tramp 2.5.0 is not fit for %s" 79 (format "Tramp 2.5.1-pre is not fit for %s"
80 (replace-regexp-in-string "\n" "" (emacs-version)))))) 80 (replace-regexp-in-string "\n" "" (emacs-version))))))
81 (unless (string-equal "ok" x) (error "%s" x))) 81 (unless (string-equal "ok" x) (error "%s" x)))
82 82
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index cc0e159faef..68dc0fb94b3 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -132,8 +132,10 @@ This is an alternative of `scroll-up'. Scope moves downward."
132 (pixel-line-height)))) 132 (pixel-line-height))))
133 (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close 133 (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
134 (scroll-up 1) ; relay on robust method 134 (scroll-up 1) ; relay on robust method
135 (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) 135 (catch 'no-movement
136 (vertical-motion 1)) ; move point downward 136 (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
137 (unless (>= (vertical-motion 1) 1) ; move point downward
138 (throw 'no-movement nil)))) ; exit loop when point did not move
137 (pixel-scroll-pixel-up amt)))))) ; move scope downward 139 (pixel-scroll-pixel-up amt)))))) ; move scope downward
138 140
139(defun pixel-scroll-down (&optional arg) 141(defun pixel-scroll-down (&optional arg)
@@ -149,8 +151,10 @@ This is and alternative of `scroll-down'. Scope moves upward."
149 pixel-resolution-fine-flag 151 pixel-resolution-fine-flag
150 (frame-char-height)) 152 (frame-char-height))
151 (pixel-line-height -1)))) 153 (pixel-line-height -1))))
152 (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries) 154 (catch 'no-movement
153 (vertical-motion -1)) ; move point upward 155 (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
156 (unless (<= (vertical-motion -1) -1) ; move point upward
157 (throw 'no-movement nil)))) ; exit loop when point did not move
154 (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen 158 (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
155 (pixel-eob-at-top-p)) ; for file with a long line 159 (pixel-eob-at-top-p)) ; for file with a long line
156 (scroll-down 1) ; relay on robust method 160 (scroll-down 1) ; relay on robust method
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index fddc13f56b1..460af718aad 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> 5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Version: 1.1.0 7;; Version: 1.1.1
8;; Keywords: c languages tools 8;; Keywords: c languages tools
9;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) 9;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
10 10
@@ -1283,6 +1283,8 @@ correctly.")
1283 (when (flymake-running-backends) flymake-mode-line-counter-format)) 1283 (when (flymake-running-backends) flymake-mode-line-counter-format))
1284 1284
1285(defun flymake--mode-line-counter (type &optional no-space) 1285(defun flymake--mode-line-counter (type &optional no-space)
1286 "Compute number of diagnostics in buffer with TYPE's severity.
1287TYPE is usually keyword `:error', `:warning' or `:note'."
1286 (let ((count 0) 1288 (let ((count 0)
1287 (face (flymake--lookup-type-property type 1289 (face (flymake--lookup-type-property type
1288 'mode-line-face 1290 'mode-line-face
@@ -1290,7 +1292,8 @@ correctly.")
1290 (maphash (lambda 1292 (maphash (lambda
1291 (_b state) 1293 (_b state)
1292 (dolist (d (flymake--backend-state-diags state)) 1294 (dolist (d (flymake--backend-state-diags state))
1293 (when (eq type (flymake--diag-type d)) 1295 (when (= (flymake--severity type)
1296 (flymake--severity (flymake--diag-type d)))
1294 (cl-incf count)))) 1297 (cl-incf count))))
1295 flymake--backend-state) 1298 flymake--backend-state)
1296 (when (or (cl-plusp count) 1299 (when (or (cl-plusp count)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 62c3cf44cb6..06966f33b72 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -970,20 +970,11 @@ loop using the command \\[fileloop-continue]."
970(declare-function compilation-read-command "compile") 970(declare-function compilation-read-command "compile")
971 971
972;;;###autoload 972;;;###autoload
973(defun project-compile (command &optional comint) 973(defun project-compile ()
974 "Run `compile' in the project root. 974 "Run `compile' in the project root."
975Arguments the same as in `compile'." 975 (interactive)
976 (interactive 976 (let ((default-directory (project-root (project-current t))))
977 (list 977 (call-interactively #'compile)))
978 (let ((command (eval compile-command)))
979 (require 'compile)
980 (if (or compilation-read-command current-prefix-arg)
981 (compilation-read-command command)
982 command))
983 (consp current-prefix-arg)))
984 (let* ((pr (project-current t))
985 (default-directory (project-root pr)))
986 (compile command comint)))
987 978
988(defun project--read-project-buffer () 979(defun project--read-project-buffer ()
989 (let* ((pr (project-current t)) 980 (let* ((pr (project-current t))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index c8f6c12a3f0..9f5f9ed6d3d 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1201,7 +1201,9 @@ Commands:
1201(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]" 1201(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
1202 "Major mode for editing Mercury programs. 1202 "Major mode for editing Mercury programs.
1203Actually this is just customized `prolog-mode'." 1203Actually this is just customized `prolog-mode'."
1204 (setq-local prolog-system 'mercury)) 1204 (setq-local prolog-system 'mercury)
1205 ;; Run once more to set up based on `prolog-system'
1206 (prolog-mode-variables))
1205 1207
1206 1208
1207;;------------------------------------------------------------------- 1209;;-------------------------------------------------------------------
@@ -2082,7 +2084,7 @@ Argument BOUND is a buffer position limiting searching."
2082 (delq 2084 (delq
2083 nil 2085 nil
2084 (cond 2086 (cond
2085 ((eq major-mode 'prolog-mode) 2087 ((derived-mode-p 'prolog-mode)
2086 (list 2088 (list
2087 head-predicates 2089 head-predicates
2088 head-predicates-1 2090 head-predicates-1
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 0965fecfb74..d6c0a4d1dbf 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -2027,8 +2027,12 @@ position, else returns nil."
2027 :group 'python 2027 :group 'python
2028 :safe 'stringp) 2028 :safe 'stringp)
2029 2029
2030(defcustom python-shell-interpreter "python" 2030(defcustom python-shell-interpreter
2031 (cond ((executable-find "python3") "python3")
2032 ((executable-find "python") "python")
2033 (t "python3"))
2031 "Default Python interpreter for shell." 2034 "Default Python interpreter for shell."
2035 :version "28.1"
2032 :type 'string 2036 :type 'string
2033 :group 'python) 2037 :group 'python)
2034 2038
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b393b8d0f1a..b6778de807d 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -663,6 +663,12 @@ means to first quit the *xref* buffer."
663 (interactive) 663 (interactive)
664 (xref-goto-xref t)) 664 (xref-goto-xref t))
665 665
666(defun xref-quit-and-pop-marker-stack ()
667 "Quit *xref* buffer, then pop the xref marker stack."
668 (interactive)
669 (quit-window)
670 (xref-pop-marker-stack))
671
666(defun xref-query-replace-in-results (from to) 672(defun xref-query-replace-in-results (from to)
667 "Perform interactive replacement of FROM with TO in all displayed xrefs. 673 "Perform interactive replacement of FROM with TO in all displayed xrefs.
668 674
@@ -793,6 +799,7 @@ references displayed in the current *xref* buffer."
793 (define-key map (kbd ".") #'xref-next-line) 799 (define-key map (kbd ".") #'xref-next-line)
794 (define-key map (kbd ",") #'xref-prev-line) 800 (define-key map (kbd ",") #'xref-prev-line)
795 (define-key map (kbd "g") #'xref-revert-buffer) 801 (define-key map (kbd "g") #'xref-revert-buffer)
802 (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack)
796 map)) 803 map))
797 804
798(define-derived-mode xref--xref-buffer-mode special-mode "XREF" 805(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
@@ -928,8 +935,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
928 (or 935 (or
929 (assoc-default 'fetched-xrefs alist) 936 (assoc-default 'fetched-xrefs alist)
930 (funcall fetcher))) 937 (funcall fetcher)))
931 (xref-alist (xref--analyze xrefs))) 938 (xref-alist (xref--analyze xrefs))
939 (dd default-directory))
932 (with-current-buffer (get-buffer-create xref-buffer-name) 940 (with-current-buffer (get-buffer-create xref-buffer-name)
941 (setq default-directory dd)
933 (xref--xref-buffer-mode) 942 (xref--xref-buffer-mode)
934 (xref--show-common-initialize xref-alist fetcher alist) 943 (xref--show-common-initialize xref-alist fetcher alist)
935 (pop-to-buffer (current-buffer)) 944 (pop-to-buffer (current-buffer))
@@ -992,13 +1001,15 @@ When only one definition found, jump to it right away instead."
992When there is more than one definition, split the selected window 1001When there is more than one definition, split the selected window
993and show the list in a small window at the bottom. And use a 1002and show the list in a small window at the bottom. And use a
994local keymap that binds `RET' to `xref-quit-and-goto-xref'." 1003local keymap that binds `RET' to `xref-quit-and-goto-xref'."
995 (let ((xrefs (funcall fetcher))) 1004 (let ((xrefs (funcall fetcher))
1005 (dd default-directory))
996 (cond 1006 (cond
997 ((not (cdr xrefs)) 1007 ((not (cdr xrefs))
998 (xref-pop-to-location (car xrefs) 1008 (xref-pop-to-location (car xrefs)
999 (assoc-default 'display-action alist))) 1009 (assoc-default 'display-action alist)))
1000 (t 1010 (t
1001 (with-current-buffer (get-buffer-create xref-buffer-name) 1011 (with-current-buffer (get-buffer-create xref-buffer-name)
1012 (setq default-directory dd)
1002 (xref--transient-buffer-mode) 1013 (xref--transient-buffer-mode)
1003 (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) 1014 (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
1004 (pop-to-buffer (current-buffer) 1015 (pop-to-buffer (current-buffer)
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7cda6c96aff..1e819044194 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -429,7 +429,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'."
429 ;; `ding' flushes the next messages about setting goal 429 ;; `ding' flushes the next messages about setting goal
430 ;; column. So here I force fetch the event(mouse-2) and 430 ;; column. So here I force fetch the event(mouse-2) and
431 ;; throw away. 431 ;; throw away.
432 (read-event) 432 (read--potential-mouse-event)
433 ;; Ding BEFORE `message' is OK. 433 ;; Ding BEFORE `message' is OK.
434 (when ruler-mode-set-goal-column-ding-flag 434 (when ruler-mode-set-goal-column-ding-flag
435 (ding)) 435 (ding))
@@ -460,7 +460,7 @@ the mouse has been clicked."
460 (track-mouse 460 (track-mouse
461 ;; Signal the display engine to freeze the mouse pointer shape. 461 ;; Signal the display engine to freeze the mouse pointer shape.
462 (setq track-mouse 'dragging) 462 (setq track-mouse 'dragging)
463 (while (mouse-movement-p (setq event (read-event))) 463 (while (mouse-movement-p (setq event (read--potential-mouse-event)))
464 (setq drags (1+ drags)) 464 (setq drags (1+ drags))
465 (when (eq window (posn-window (event-end event))) 465 (when (eq window (posn-window (event-end event)))
466 (ruler-mode-mouse-drag-any-column event) 466 (ruler-mode-mouse-drag-any-column event)
diff --git a/lisp/shell.el b/lisp/shell.el
index c179dd24d3f..0f866158fe3 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -603,6 +603,7 @@ buffer."
603 (or hfile 603 (or hfile
604 (cond ((string-equal shell "bash") "~/.bash_history") 604 (cond ((string-equal shell "bash") "~/.bash_history")
605 ((string-equal shell "ksh") "~/.sh_history") 605 ((string-equal shell "ksh") "~/.sh_history")
606 ((string-equal shell "zsh") "~/.zsh_history")
606 (t "~/.history"))))) 607 (t "~/.history")))))
607 (if (or (equal comint-input-ring-file-name "") 608 (if (or (equal comint-input-ring-file-name "")
608 (equal (file-truename comint-input-ring-file-name) 609 (equal (file-truename comint-input-ring-file-name)
diff --git a/lisp/simple.el b/lisp/simple.el
index 54c35c04bea..37c0885dcc5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5606,7 +5606,9 @@ See also `zap-up-to-char'."
5606;; kill-line and its subroutines. 5606;; kill-line and its subroutines.
5607 5607
5608(defcustom kill-whole-line nil 5608(defcustom kill-whole-line nil
5609 "If non-nil, `kill-line' with no arg at start of line kills the whole line." 5609 "If non-nil, `kill-line' with no arg at start of line kills the whole line.
5610This variable also affects `kill-visual-line' in the same way as
5611it does `kill-line'."
5610 :type 'boolean 5612 :type 'boolean
5611 :group 'killing) 5613 :group 'killing)
5612 5614
@@ -7319,6 +7321,10 @@ If ARG is negative, kill visual lines backward.
7319If ARG is zero, kill the text before point on the current visual 7321If ARG is zero, kill the text before point on the current visual
7320line. 7322line.
7321 7323
7324If the variable `kill-whole-line' is non-nil, and this command is
7325invoked at start of a line that ends in a newline, kill the newline
7326as well.
7327
7322If you want to append the killed line to the last killed text, 7328If you want to append the killed line to the last killed text,
7323use \\[append-next-kill] before \\[kill-line]. 7329use \\[append-next-kill] before \\[kill-line].
7324 7330
@@ -7331,18 +7337,30 @@ even beep.)"
7331 ;; Like in `kill-line', it's better to move point to the other end 7337 ;; Like in `kill-line', it's better to move point to the other end
7332 ;; of the kill before killing. 7338 ;; of the kill before killing.
7333 (let ((opoint (point)) 7339 (let ((opoint (point))
7334 (kill-whole-line (and kill-whole-line (bolp)))) 7340 (kill-whole-line (and kill-whole-line (bolp)))
7341 (orig-y (cdr (nth 2 (posn-at-point))))
7342 ;; FIXME: This tolerance should be zero! It isn't due to a
7343 ;; bug in posn-at-point, see bug#45837.
7344 (tol (/ (line-pixel-height) 2)))
7335 (if arg 7345 (if arg
7336 (vertical-motion (prefix-numeric-value arg)) 7346 (vertical-motion (prefix-numeric-value arg))
7337 (end-of-visual-line 1) 7347 (end-of-visual-line 1)
7338 (if (= (point) opoint) 7348 (if (= (point) opoint)
7339 (vertical-motion 1) 7349 (vertical-motion 1)
7340 ;; Skip any trailing whitespace at the end of the visual line. 7350 ;; The first condition below verifies we are still on the same
7341 ;; We used to do this only if `show-trailing-whitespace' is 7351 ;; screen line, i.e. that the line isn't continued, and that
7342 ;; nil, but that's wrong; the correct thing would be to check 7352 ;; end-of-visual-line didn't overshoot due to complications
7343 ;; whether the trailing whitespace is highlighted. But, it's 7353 ;; like display or overlay strings, intangible text, etc.:
7344 ;; OK to just do this unconditionally. 7354 ;; otherwise, we don't want to kill a character that's
7345 (skip-chars-forward " \t"))) 7355 ;; unrelated to the place where the visual line wrapped.
7356 (and (< (abs (- (cdr (nth 2 (posn-at-point))) orig-y)) tol)
7357 ;; Make sure we delete the character where the line wraps
7358 ;; under visual-line-mode, be it whitespace or a
7359 ;; character whose category set allows to wrap at it.
7360 (or (looking-at-p "[ \t]")
7361 (and word-wrap-by-category
7362 (aref (char-category-set (following-char)) ?\|)))
7363 (forward-char))))
7346 (kill-region opoint (if (and kill-whole-line (= (following-char) ?\n)) 7364 (kill-region opoint (if (and kill-whole-line (= (following-char) ?\n))
7347 (1+ (point)) 7365 (1+ (point))
7348 (point))))) 7366 (point)))))
diff --git a/lisp/startup.el b/lisp/startup.el
index 8a8e8354900..9325ab5acff 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -929,7 +929,8 @@ the name of the init-file to load. If this file cannot be
929loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is 929loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is
930called with no arguments and should return the name of an 930called with no arguments and should return the name of an
931alternate init-file to load. If LOAD-DEFAULTS is non-nil, then 931alternate init-file to load. If LOAD-DEFAULTS is non-nil, then
932load default.el after the init-file. 932load default.el after the init-file, unless `inhibit-default-init'
933is non-nil.
933 934
934This function sets `user-init-file' to the name of the loaded 935This function sets `user-init-file' to the name of the loaded
935init-file, or to a default value if loading is not possible." 936init-file, or to a default value if loading is not possible."
@@ -985,8 +986,8 @@ init-file, or to a default value if loading is not possible."
985 (sit-for 1)) 986 (sit-for 1))
986 (setq user-init-file source)))) 987 (setq user-init-file source))))
987 988
988 (when load-defaults 989 (when (and load-defaults
989 990 (not inhibit-default-init))
990 ;; Prevent default.el from changing the value of 991 ;; Prevent default.el from changing the value of
991 ;; `inhibit-startup-screen'. 992 ;; `inhibit-startup-screen'.
992 (let ((inhibit-startup-screen nil)) 993 (let ((inhibit-startup-screen nil))
@@ -1174,12 +1175,11 @@ please check its value")
1174 1175
1175 ;; Re-evaluate predefined variables whose initial value depends on 1176 ;; Re-evaluate predefined variables whose initial value depends on
1176 ;; the runtime context. 1177 ;; the runtime context.
1177 (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH 1178 (setq custom-delayed-init-variables
1178 (setq custom-delayed-init-variables 1179 ;; Initialize them in the same order they were loaded, in case there
1179 ;; Initialize them in the same order they were loaded, in case there 1180 ;; are dependencies between them.
1180 ;; are dependencies between them. 1181 (nreverse custom-delayed-init-variables))
1181 (nreverse custom-delayed-init-variables)) 1182 (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
1182 (mapc 'custom-reevaluate-setting custom-delayed-init-variables))
1183 1183
1184 ;; Warn for invalid user name. 1184 ;; Warn for invalid user name.
1185 (when init-file-user 1185 (when init-file-user
@@ -1296,8 +1296,7 @@ please check its value")
1296 (if (or noninteractive emacs-basic-display) 1296 (if (or noninteractive emacs-basic-display)
1297 (setq menu-bar-mode nil 1297 (setq menu-bar-mode nil
1298 tab-bar-mode nil 1298 tab-bar-mode nil
1299 tool-bar-mode nil 1299 tool-bar-mode nil))
1300 no-blinking-cursor t))
1301 (frame-initialize)) 1300 (frame-initialize))
1302 1301
1303 (when (fboundp 'x-create-frame) 1302 (when (fboundp 'x-create-frame)
@@ -1306,15 +1305,6 @@ please check its value")
1306 (unless noninteractive 1305 (unless noninteractive
1307 (tool-bar-setup))) 1306 (tool-bar-setup)))
1308 1307
1309 ;; Turn off blinking cursor if so specified in X resources. This is here
1310 ;; only because all other settings of no-blinking-cursor are here.
1311 (unless (or noninteractive
1312 emacs-basic-display
1313 (and (memq window-system '(x w32 ns))
1314 (not (member (x-get-resource "cursorBlink" "CursorBlink")
1315 '("no" "off" "false" "0")))))
1316 (setq no-blinking-cursor t))
1317
1318 (unless noninteractive 1308 (unless noninteractive
1319 (startup--setup-quote-display) 1309 (startup--setup-quote-display)
1320 (setq internal--text-quoting-flag t)) 1310 (setq internal--text-quoting-flag t))
@@ -1322,9 +1312,8 @@ please check its value")
1322 ;; Re-evaluate again the predefined variables whose initial value 1312 ;; Re-evaluate again the predefined variables whose initial value
1323 ;; depends on the runtime context, in case some of them depend on 1313 ;; depends on the runtime context, in case some of them depend on
1324 ;; the window-system features. Example: blink-cursor-mode. 1314 ;; the window-system features. Example: blink-cursor-mode.
1325 (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH 1315 (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
1326 (mapc 'custom-reevaluate-setting custom-delayed-init-variables) 1316 (setq custom-delayed-init-variables nil)
1327 (setq custom-delayed-init-variables nil))
1328 1317
1329 (normal-erase-is-backspace-setup-frame) 1318 (normal-erase-is-backspace-setup-frame)
1330 1319
@@ -1382,7 +1371,7 @@ please check its value")
1382 (expand-file-name 1371 (expand-file-name
1383 "init.el" 1372 "init.el"
1384 startup-init-directory)) 1373 startup-init-directory))
1385 (not inhibit-default-init)) 1374 t)
1386 1375
1387 (when (and deactivate-mark transient-mark-mode) 1376 (when (and deactivate-mark transient-mark-mode)
1388 (with-current-buffer (window-buffer) 1377 (with-current-buffer (window-buffer)
diff --git a/lisp/strokes.el b/lisp/strokes.el
index b0ab4f990f6..55f2ae8cc47 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -756,12 +756,12 @@ Optional EVENT is acceptable as the starting event of the stroke."
756 (strokes-fill-current-buffer-with-whitespace)) 756 (strokes-fill-current-buffer-with-whitespace))
757 (when prompt 757 (when prompt
758 (message "%s" prompt) 758 (message "%s" prompt)
759 (setq event (read-event)) 759 (setq event (read--potential-mouse-event))
760 (or (strokes-button-press-event-p event) 760 (or (strokes-button-press-event-p event)
761 (error "You must draw with the mouse"))) 761 (error "You must draw with the mouse")))
762 (unwind-protect 762 (unwind-protect
763 (track-mouse 763 (track-mouse
764 (or event (setq event (read-event) 764 (or event (setq event (read--potential-mouse-event)
765 safe-to-draw-p t)) 765 safe-to-draw-p t))
766 (while (not (strokes-button-release-event-p event)) 766 (while (not (strokes-button-release-event-p event))
767 (if (strokes-mouse-event-p event) 767 (if (strokes-mouse-event-p event)
@@ -776,7 +776,7 @@ Optional EVENT is acceptable as the starting event of the stroke."
776 (setq safe-to-draw-p t)) 776 (setq safe-to-draw-p t))
777 (push (cdr (mouse-pixel-position)) 777 (push (cdr (mouse-pixel-position))
778 pix-locs))) 778 pix-locs)))
779 (setq event (read-event))))) 779 (setq event (read--potential-mouse-event)))))
780 ;; protected 780 ;; protected
781 ;; clean up strokes buffer and then bury it. 781 ;; clean up strokes buffer and then bury it.
782 (when (equal (buffer-name) strokes-buffer-name) 782 (when (equal (buffer-name) strokes-buffer-name)
@@ -787,16 +787,16 @@ Optional EVENT is acceptable as the starting event of the stroke."
787 ;; Otherwise, don't use strokes buffer and read stroke silently 787 ;; Otherwise, don't use strokes buffer and read stroke silently
788 (when prompt 788 (when prompt
789 (message "%s" prompt) 789 (message "%s" prompt)
790 (setq event (read-event)) 790 (setq event (read--potential-mouse-event))
791 (or (strokes-button-press-event-p event) 791 (or (strokes-button-press-event-p event)
792 (error "You must draw with the mouse"))) 792 (error "You must draw with the mouse")))
793 (track-mouse 793 (track-mouse
794 (or event (setq event (read-event))) 794 (or event (setq event (read--potential-mouse-event)))
795 (while (not (strokes-button-release-event-p event)) 795 (while (not (strokes-button-release-event-p event))
796 (if (strokes-mouse-event-p event) 796 (if (strokes-mouse-event-p event)
797 (push (cdr (mouse-pixel-position)) 797 (push (cdr (mouse-pixel-position))
798 pix-locs)) 798 pix-locs))
799 (setq event (read-event)))) 799 (setq event (read--potential-mouse-event))))
800 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) 800 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
801 (strokes-fill-stroke 801 (strokes-fill-stroke
802 (strokes-eliminate-consecutive-redundancies grid-locs))))) 802 (strokes-eliminate-consecutive-redundancies grid-locs)))))
@@ -817,10 +817,10 @@ Optional EVENT is acceptable as the starting event of the stroke."
817 (if prompt 817 (if prompt
818 (while (not (strokes-button-press-event-p event)) 818 (while (not (strokes-button-press-event-p event))
819 (message "%s" prompt) 819 (message "%s" prompt)
820 (setq event (read-event)))) 820 (setq event (read--potential-mouse-event))))
821 (unwind-protect 821 (unwind-protect
822 (track-mouse 822 (track-mouse
823 (or event (setq event (read-event))) 823 (or event (setq event (read--potential-mouse-event)))
824 (while (not (and (strokes-button-press-event-p event) 824 (while (not (and (strokes-button-press-event-p event)
825 (eq 'mouse-3 825 (eq 'mouse-3
826 (car (get (car event) 826 (car (get (car event)
@@ -834,14 +834,15 @@ Optional EVENT is acceptable as the starting event of the stroke."
834 ?\s strokes-character)) 834 ?\s strokes-character))
835 (push (cdr (mouse-pixel-position)) 835 (push (cdr (mouse-pixel-position))
836 pix-locs))) 836 pix-locs)))
837 (setq event (read-event))) 837 (setq event (read--potential-mouse-event)))
838 (push strokes-lift pix-locs) 838 (push strokes-lift pix-locs)
839 (while (not (strokes-button-press-event-p event)) 839 (while (not (strokes-button-press-event-p event))
840 (setq event (read-event)))) 840 (setq event (read--potential-mouse-event))))
841 ;; ### KLUDGE! ### sit and wait 841 ;; ### KLUDGE! ### sit and wait
842 ;; for some useless event to 842 ;; for some useless event to
843 ;; happen to fix the minibuffer bug. 843 ;; happen to fix the minibuffer bug.
844 (while (not (strokes-button-release-event-p (read-event)))) 844 (while (not (strokes-button-release-event-p
845 (read--potential-mouse-event))))
845 (setq pix-locs (nreverse (cdr pix-locs)) 846 (setq pix-locs (nreverse (cdr pix-locs))
846 grid-locs (strokes-renormalize-to-grid pix-locs)) 847 grid-locs (strokes-renormalize-to-grid pix-locs))
847 (strokes-fill-stroke 848 (strokes-fill-stroke
diff --git a/lisp/subr.el b/lisp/subr.el
index 6513950e4ef..b1295a0f0d6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1183,6 +1183,30 @@ KEY is a string or vector representing a sequence of keystrokes."
1183 (if (current-local-map) 1183 (if (current-local-map)
1184 (local-set-key key nil)) 1184 (local-set-key key nil))
1185 nil) 1185 nil)
1186
1187(defun local-key-binding (keys &optional accept-default)
1188 "Return the binding for command KEYS in current local keymap only.
1189KEYS is a string or vector, a sequence of keystrokes.
1190The binding is probably a symbol with a function definition.
1191
1192If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1193bindings; see the description of `lookup-key' for more details
1194about this."
1195 (let ((map (current-local-map)))
1196 (when map (lookup-key map keys accept-default))))
1197
1198(defun global-key-binding (keys &optional accept-default)
1199 "Return the binding for command KEYS in current global keymap only.
1200KEYS is a string or vector, a sequence of keystrokes.
1201The binding is probably a symbol with a function definition.
1202This function's return values are the same as those of `lookup-key'
1203\(which see).
1204
1205If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1206bindings; see the description of `lookup-key' for more details
1207about this."
1208 (lookup-key (current-global-map) keys accept-default))
1209
1186 1210
1187;;;; substitute-key-definition and its subroutines. 1211;;;; substitute-key-definition and its subroutines.
1188 1212
@@ -1335,7 +1359,9 @@ The normal global definition of the character C-x indirects to this keymap.")
1335 map) 1359 map)
1336 "Default global keymap mapping Emacs keyboard input into commands. 1360 "Default global keymap mapping Emacs keyboard input into commands.
1337The value is a keymap that is usually (but not necessarily) Emacs's 1361The value is a keymap that is usually (but not necessarily) Emacs's
1338global map.") 1362global map.
1363
1364See also `current-global-map'.")
1339(use-global-map global-map) 1365(use-global-map global-map)
1340 1366
1341 1367
@@ -1879,9 +1905,33 @@ all symbols are bound before any of the VALUEFORMs are evalled."
1879 ;; As a special-form, we could implement it more efficiently (and cleanly, 1905 ;; As a special-form, we could implement it more efficiently (and cleanly,
1880 ;; making the vars actually unbound during evaluation of the binders). 1906 ;; making the vars actually unbound during evaluation of the binders).
1881 (declare (debug let) (indent 1)) 1907 (declare (debug let) (indent 1))
1882 `(let ,(mapcar #'car binders) 1908 ;; Use plain `let*' for the non-recursive definitions.
1883 ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) 1909 ;; This only handles the case where the first few definitions are not
1884 ,@body)) 1910 ;; recursive. Nothing as fancy as an SCC analysis.
1911 (let ((seqbinds nil))
1912 ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
1913 ;; may fail to see references that will be introduced later by
1914 ;; macroexpansion. We could call `macroexpand-all' to avoid that,
1915 ;; but in order to avoid that, we instead check to see if the binders
1916 ;; appear in the macroexp environment, since that's how references can be
1917 ;; introduced later on.
1918 (unless (macroexp--fgrep binders macroexpand-all-environment)
1919 (while (and binders
1920 (null (macroexp--fgrep binders (nth 1 (car binders)))))
1921 (push (pop binders) seqbinds)))
1922 (let ((nbody (if (null binders)
1923 (macroexp-progn body)
1924 `(let ,(mapcar #'car binders)
1925 ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
1926 ,@body))))
1927 (cond
1928 ;; All bindings are recursive.
1929 ((null seqbinds) nbody)
1930 ;; Special case for trivial uses.
1931 ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
1932 (nth 1 (car seqbinds)))
1933 ;; General case.
1934 (t `(let* ,(nreverse seqbinds) ,nbody))))))
1885 1935
1886(defmacro dlet (binders &rest body) 1936(defmacro dlet (binders &rest body)
1887 "Like `let*' but using dynamic scoping." 1937 "Like `let*' but using dynamic scoping."
@@ -2524,23 +2574,52 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
2524 2574
2525;;;; Input and display facilities. 2575;;;; Input and display facilities.
2526 2576
2527(defconst read-key-empty-map (make-sparse-keymap)) 2577;; The following maps are used by `read-key' to remove all key
2578;; bindings while calling `read-key-sequence'. This way the keys
2579;; returned are independent of the key binding state.
2580
2581(defconst read-key-empty-map (make-sparse-keymap)
2582 "Used internally by `read-key'.")
2583
2584(defconst read-key-full-map
2585 (let ((map (make-sparse-keymap)))
2586 (define-key map [t] 'dummy)
2587
2588 ;; ESC needs to be unbound so that escape sequences in
2589 ;; `input-decode-map' are still processed by `read-key-sequence'.
2590 (define-key map [?\e] nil)
2591 map)
2592 "Used internally by `read-key'.")
2528 2593
2529(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. 2594(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
2530 2595
2531(defun read-key (&optional prompt) 2596(defun read-key (&optional prompt disable-fallbacks)
2532 "Read a key from the keyboard. 2597 "Read a key from the keyboard.
2533Contrary to `read-event' this will not return a raw event but instead will 2598Contrary to `read-event' this will not return a raw event but instead will
2534obey the input decoding and translations usually done by `read-key-sequence'. 2599obey the input decoding and translations usually done by `read-key-sequence'.
2535So escape sequences and keyboard encoding are taken into account. 2600So escape sequences and keyboard encoding are taken into account.
2536When there's an ambiguity because the key looks like the prefix of 2601When there's an ambiguity because the key looks like the prefix of
2537some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." 2602some sort of escape sequence, the ambiguity is resolved via `read-key-delay'.
2603
2604If the optional argument PROMPT is non-nil, display that as a
2605prompt.
2606
2607If the optional argument DISABLE-FALLBACKS is non-nil, all
2608unbound fallbacks usually done by `read-key-sequence' are
2609disabled such as discarding mouse down events. This is generally
2610what you want as `read-key' temporarily removes all bindings
2611while calling `read-key-sequence'. If nil or unspecified, the
2612only unbound fallback disabled is downcasing of the last event."
2538 ;; This overriding-terminal-local-map binding also happens to 2613 ;; This overriding-terminal-local-map binding also happens to
2539 ;; disable quail's input methods, so although read-key-sequence 2614 ;; disable quail's input methods, so although read-key-sequence
2540 ;; always inherits the input method, in practice read-key does not 2615 ;; always inherits the input method, in practice read-key does not
2541 ;; inherit the input method (at least not if it's based on quail). 2616 ;; inherit the input method (at least not if it's based on quail).
2542 (let ((overriding-terminal-local-map nil) 2617 (let ((overriding-terminal-local-map nil)
2543 (overriding-local-map read-key-empty-map) 2618 (overriding-local-map
2619 ;; FIXME: Audit existing uses of `read-key' to see if they
2620 ;; should always specify disable-fallbacks to be more in line
2621 ;; with `read-event'.
2622 (if disable-fallbacks read-key-full-map read-key-empty-map))
2544 (echo-keystrokes 0) 2623 (echo-keystrokes 0)
2545 (old-global-map (current-global-map)) 2624 (old-global-map (current-global-map))
2546 (timer (run-with-idle-timer 2625 (timer (run-with-idle-timer
@@ -2594,6 +2673,23 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
2594 (message nil) 2673 (message nil)
2595 (use-global-map old-global-map)))) 2674 (use-global-map old-global-map))))
2596 2675
2676;; FIXME: Once there's a safe way to transition away from read-event,
2677;; callers to this function should be updated to that way and this
2678;; function should be deleted.
2679(defun read--potential-mouse-event ()
2680 "Read an event that might be a mouse event.
2681
2682This function exists for backward compatibility in code packaged
2683with Emacs. Do not call it directly in your own packages."
2684 ;; `xterm-mouse-mode' events must go through `read-key' as they
2685 ;; are decoded via `input-decode-map'.
2686 (if xterm-mouse-mode
2687 (read-key nil
2688 ;; Normally `read-key' discards all mouse button
2689 ;; down events. However, we want them here.
2690 t)
2691 (read-event)))
2692
2597(defvar read-passwd-map 2693(defvar read-passwd-map
2598 ;; BEWARE: `defconst' would purecopy it, breaking the sharing with 2694 ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
2599 ;; minibuffer-local-map along the way! 2695 ;; minibuffer-local-map along the way!
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index ce620821d65..50c00c95320 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -5004,7 +5004,7 @@ The event, EV, is the mouse event."
5004 (setq timer (run-at-time interval interval draw-fn x1 y1)))) 5004 (setq timer (run-at-time interval interval draw-fn x1 y1))))
5005 5005
5006 ;; Read next event 5006 ;; Read next event
5007 (setq ev (read-event)))) 5007 (setq ev (read--potential-mouse-event))))
5008 ;; Cleanup: get rid of any active timer. 5008 ;; Cleanup: get rid of any active timer.
5009 (if timer 5009 (if timer
5010 (cancel-timer timer))) 5010 (cancel-timer timer)))
@@ -5212,7 +5212,7 @@ The event, EV, is the mouse event."
5212 5212
5213 ;; Read next event (only if we should not stop) 5213 ;; Read next event (only if we should not stop)
5214 (if (not done) 5214 (if (not done)
5215 (setq ev (read-event))))) 5215 (setq ev (read--potential-mouse-event)))))
5216 5216
5217 ;; Reverse point-list (last points are cond'ed first) 5217 ;; Reverse point-list (last points are cond'ed first)
5218 (setq point-list (reverse point-list)) 5218 (setq point-list (reverse point-list))
@@ -5339,7 +5339,7 @@ The event, EV, is the mouse event."
5339 5339
5340 5340
5341 ;; Read next event 5341 ;; Read next event
5342 (setq ev (read-event)))) 5342 (setq ev (read--potential-mouse-event))))
5343 5343
5344 ;; If we are not rubber-banding (that is, we were moving around the `2') 5344 ;; If we are not rubber-banding (that is, we were moving around the `2')
5345 ;; draw the shape 5345 ;; draw the shape
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 3346c551d93..6681b03913c 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -743,9 +743,16 @@ space does not end a sentence, so don't break a line there."
743 743
744 ;; This is the actual filling loop. 744 ;; This is the actual filling loop.
745 (goto-char from) 745 (goto-char from)
746 (let (linebeg) 746 (let ((first t)
747 linebeg)
747 (while (< (point) to) 748 (while (< (point) to)
748 (setq linebeg (point)) 749 ;; On the first line, there may be text in the fill prefix
750 ;; zone. In that case, don't consider that area when
751 ;; trying to find a place to put a line break (bug#45720).
752 (if (not first)
753 (setq linebeg (point))
754 (setq first nil
755 linebeg (+ (point) (length fill-prefix))))
749 (move-to-column (current-fill-column)) 756 (move-to-column (current-fill-column))
750 (if (when (< (point) to) 757 (if (when (< (point) to)
751 ;; Find the position where we'll break the line. 758 ;; Find the position where we'll break the line.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 073059d52e8..1b29eafabf7 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -900,13 +900,14 @@ DOWNCASE t: Downcase words before using them."
900 ,(concat 900 ,(concat
901 ;; Make sure we search only for optional arguments of 901 ;; Make sure we search only for optional arguments of
902 ;; environments/macros and don't match any other [. ctable 902 ;; environments/macros and don't match any other [. ctable
903 ;; provides a macro called \ctable, listings/breqn have 903 ;; provides a macro called \ctable, beamer/breqn/listings have
904 ;; environments. Start with a backslash and a group for names 904 ;; environments. Start with a backslash and a group for names
905 "\\\\\\(?:" 905 "\\\\\\(?:"
906 ;; begin, optional spaces and opening brace 906 ;; begin, optional spaces and opening brace
907 "begin[[:space:]]*{" 907 "begin[[:space:]]*{"
908 ;; Build a regexp for env names 908 ;; Build a regexp for env names
909 (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray")) 909 (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
910 "darray" "frame"))
910 ;; closing brace, optional spaces 911 ;; closing brace, optional spaces
911 "}[[:space:]]*" 912 "}[[:space:]]*"
912 ;; Now for macros 913 ;; Now for macros
@@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them."
919 "\\[[^][]*" 920 "\\[[^][]*"
920 ;; Allow nested levels of chars enclosed in braces 921 ;; Allow nested levels of chars enclosed in braces
921 "\\(?:{[^}{]*" 922 "\\(?:{[^}{]*"
922 "\\(?:{[^}{]*" 923 "\\(?:{[^}{]*"
923 "\\(?:{[^}{]*}[^}{]*\\)*" 924 "\\(?:{[^}{]*}[^}{]*\\)*"
924 "}[^}{]*\\)*" 925 "}[^}{]*\\)*"
925 "}[^][]*\\)*" 926 "}[^][]*\\)*"
926 ;; Match the label key 927 ;; Match the label key
927 "\\<label[[:space:]]*=[[:space:]]*" 928 "\\<label[[:space:]]*=[[:space:]]*"
@@ -935,8 +936,9 @@ The default value matches usual \\label{...} definitions and
935keyval style [..., label = {...}, ...] label definitions. The 936keyval style [..., label = {...}, ...] label definitions. The
936regexp for keyval style explicitly looks for environments 937regexp for keyval style explicitly looks for environments
937provided by the packages \"listings\" (\"lstlisting\"), 938provided by the packages \"listings\" (\"lstlisting\"),
938\"breqn\" (\"dmath\", \"dseries\", \"dgroup\", \"darray\") and 939\"beamer\" (\"frame\"), \"breqn\" (\"dmath\", \"dseries\",
939the macro \"\\ctable\" provided by the package of the same name. 940\"dgroup\", \"darray\") and the macro \"\\ctable\" provided by
941the package of the same name.
940 942
941It is assumed that the regexp group 1 matches the label text, so 943It is assumed that the regexp group 1 matches the label text, so
942you have to define it using \\(?1:...\\) when adding new regexps. 944you have to define it using \\(?1:...\\) when adding new regexps.
@@ -944,7 +946,7 @@ you have to define it using \\(?1:...\\) when adding new regexps.
944When changed from Lisp, make sure to call 946When changed from Lisp, make sure to call
945`reftex-compile-variables' afterwards to make the change 947`reftex-compile-variables' afterwards to make the change
946effective." 948effective."
947 :version "27.1" 949 :version "28.1"
948 :set (lambda (symbol value) 950 :set (lambda (symbol value)
949 (set symbol value) 951 (set symbol value)
950 (when (fboundp 'reftex-compile-variables) 952 (when (fboundp 'reftex-compile-variables)
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 72b345874f9..47ef37a19ee 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -262,11 +262,12 @@ keyboard input to go into icons."
262 (let (event) 262 (let (event)
263 (message 263 (message
264 "Select windows by clicking. Please click on Window %d " wind-number) 264 "Select windows by clicking. Please click on Window %d " wind-number)
265 (while (not (ediff-mouse-event-p (setq event (read-event)))) 265 (while (not (ediff-mouse-event-p (setq event
266 (read--potential-mouse-event))))
266 (if (sit-for 1) ; if sequence of events, wait till the final word 267 (if (sit-for 1) ; if sequence of events, wait till the final word
267 (beep 1)) 268 (beep 1))
268 (message "Please click on Window %d " wind-number)) 269 (message "Please click on Window %d " wind-number))
269 (read-event) ; discard event 270 (read--potential-mouse-event) ; discard event
270 (posn-window (event-start event)))) 271 (posn-window (event-start event))))
271 272
272 273
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index e3612dd8e34..ed375738b47 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -939,7 +939,7 @@ arguments after setting up the Ediff buffers."
939;; If WIND-A is nil, use selected window. 939;; If WIND-A is nil, use selected window.
940;; If WIND-B is nil, use window next to WIND-A. 940;; If WIND-B is nil, use window next to WIND-A.
941(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode) 941(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode)
942 (if (or dumb-mode (not (ediff-window-display-p))) 942 (if (or dumb-mode (not (display-mouse-p)))
943 (setq wind-A (ediff-get-next-window wind-A nil) 943 (setq wind-A (ediff-get-next-window wind-A nil)
944 wind-B (ediff-get-next-window wind-B wind-A)) 944 wind-B (ediff-get-next-window wind-B wind-A))
945 (setq wind-A (ediff-get-window-by-clicking wind-A nil 1) 945 (setq wind-A (ediff-get-window-by-clicking wind-A nil 1)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 8b10d71dcb3..7dda04eda21 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1104,7 +1104,7 @@ If nothing was called, return non-nil."
1104 (unless (widget-apply button :mouse-down-action event) 1104 (unless (widget-apply button :mouse-down-action event)
1105 (let ((track-mouse t)) 1105 (let ((track-mouse t))
1106 (while (not (widget-button-release-event-p event)) 1106 (while (not (widget-button-release-event-p event))
1107 (setq event (read-event)) 1107 (setq event (read--potential-mouse-event))
1108 (when (and mouse-1 (mouse-movement-p event)) 1108 (when (and mouse-1 (mouse-movement-p event))
1109 (push event unread-command-events) 1109 (push event unread-command-events)
1110 (setq event oevent) 1110 (setq event oevent)
@@ -1169,7 +1169,7 @@ If nothing was called, return non-nil."
1169 (when up 1169 (when up
1170 ;; Don't execute up events twice. 1170 ;; Don't execute up events twice.
1171 (while (not (widget-button-release-event-p event)) 1171 (while (not (widget-button-release-event-p event))
1172 (setq event (read-event)))) 1172 (setq event (read--potential-mouse-event))))
1173 (when command 1173 (when command
1174 (call-interactively command))))) 1174 (call-interactively command)))))
1175 (message "You clicked somewhere weird."))) 1175 (message "You clicked somewhere weird.")))
@@ -3486,14 +3486,16 @@ It reads a directory name from an editable text field."
3486 :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value" 3486 :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
3487 :tag "Key sequence") 3487 :tag "Key sequence")
3488 3488
3489;; FIXME: Consider combining this with help--read-key-sequence which
3490;; can also read double and triple mouse events.
3489(defun widget-key-sequence-read-event (ev) 3491(defun widget-key-sequence-read-event (ev)
3490 (interactive (list 3492 (interactive (list
3491 (let ((inhibit-quit t) quit-flag) 3493 (let ((inhibit-quit t) quit-flag)
3492 (read-event "Insert KEY, EVENT, or CODE: ")))) 3494 (read-key "Insert KEY, EVENT, or CODE: " t))))
3493 (let ((ev2 (and (memq 'down (event-modifiers ev)) 3495 (let ((ev2 (and (memq 'down (event-modifiers ev))
3494 (read-event))) 3496 (read-key nil t)))
3495 (tr (and (keymapp function-key-map) 3497 (tr (and (keymapp local-function-key-map)
3496 (lookup-key function-key-map (vector ev))))) 3498 (lookup-key local-function-key-map (vector ev)))))
3497 (when (and (integerp ev) 3499 (when (and (integerp ev)
3498 (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix)))) 3500 (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix))))
3499 (and (<= ?a (downcase ev)) 3501 (and (<= ?a (downcase ev))
diff --git a/lisp/window.el b/lisp/window.el
index 38be7789062..0a37d16273f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1736,9 +1736,11 @@ interpret DELTA as pixels."
1736 (setq window (window-normalize-window window)) 1736 (setq window (window-normalize-window window))
1737 (cond 1737 (cond
1738 ((< delta 0) 1738 ((< delta 0)
1739 (max (- (window-min-size window horizontal ignore pixelwise) 1739 (let ((min-size (window-min-size window horizontal ignore pixelwise))
1740 (window-size window horizontal pixelwise)) 1740 (size (window-size window horizontal pixelwise)))
1741 delta)) 1741 (if (<= size min-size)
1742 0
1743 (max (- min-size size) delta))))
1742 ((> delta 0) 1744 ((> delta 0)
1743 (if (window-size-fixed-p window horizontal ignore) 1745 (if (window-size-fixed-p window horizontal ignore)
1744 0 1746 0
@@ -4116,7 +4118,10 @@ frame can be safely deleted."
4116 frame)) 4118 frame))
4117 (throw 'other t)))) 4119 (throw 'other t))))
4118 (let ((minibuf (active-minibuffer-window))) 4120 (let ((minibuf (active-minibuffer-window)))
4119 (and minibuf (eq frame (window-frame minibuf))))) 4121 (and minibuf (eq frame (window-frame minibuf))
4122 (not (eq (default-toplevel-value
4123 minibuffer-follows-selected-frame)
4124 t)))))
4120 'frame)) 4125 'frame))
4121 ((window-minibuffer-p window) 4126 ((window-minibuffer-p window)
4122 ;; If WINDOW is the minibuffer window of a non-minibuffer-only 4127 ;; If WINDOW is the minibuffer window of a non-minibuffer-only
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-23 15:04:41 +0000