diff options
Diffstat (limited to 'lisp')
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'.") (ignore-errors (define-key calc-digit-map x 'calcDigit-delchar) (define-key calc-mode-map x 'calc-pop) - (define-key calc-mode-map - (if (and (vectorp x) (featurep 'xemacs)) - (if (= (length x) 1) - (vector (if (consp (aref x 0)) - (cons 'meta (aref x 0)) - (list 'meta (aref x 0)))) - "\e\C-d") - (vconcat "\e" x)) - 'calc-pop-above))) + (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above))) (if calc-scan-for-dels (append (where-is-internal 'delete-forward-char global-map) '("\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 can be used to define that match without loading the specific project into memory.") +(cl-defmethod ede-calc-fromconfig ((dirmatch ede-project-autoload-dirmatch)) + "Calculate the value of :fromconfig from DIRMATCH." + (let* ((fc (oref dirmatch fromconfig)) + (found (cond ((stringp fc) fc) + ((functionp fc) (funcall fc)) + (t (error "Unknown dirmatch object match style."))))) + (expand-file-name found) + )) + (cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch)) "Return non-nil if the tool DIRMATCH might match is installed on the system." - (let ((fc (oref dirmatch fromconfig))) - - (cond - ;; If the thing to match is stored in a config file. - ((stringp fc) - (file-exists-p fc)) - - ;; Add new types of dirmatches here. - - ;; Error for weird stuff - (t (error "Unknown dirmatch type."))))) - + (file-exists-p (ede-calc-fromconfig dirmatch))) (cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file) "Does DIRMATCH match the filename FILE." - (let ((fc (oref dirmatch fromconfig))) + (let ((fc (ede-calc-fromconfig dirmatch))) (cond ;; 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'." (ring (make-ring ring-size)) ;; Use possibly buffer-local values of these variables. (ring-separator comint-input-ring-separator) + (ring-file-prefix comint-input-ring-file-prefix) (history-ignore comint-input-history-ignore) (ignoredups comint-input-ignoredups)) (with-temp-buffer @@ -990,24 +991,15 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'." (while (and (< count comint-input-ring-size) (re-search-backward ring-separator nil t) (setq end (match-beginning 0))) - (setq start - (if (re-search-backward ring-separator nil t) - (progn - (when (and comint-input-ring-file-prefix - (looking-at - comint-input-ring-file-prefix)) - ;; Skip zsh extended_history stamps - (goto-char (match-end 0))) - (match-end 0)) - (progn - (goto-char (point-min)) - (when (and comint-input-ring-file-prefix - (looking-at - comint-input-ring-file-prefix)) - (goto-char (match-end 0))) - (point)))) + (goto-char (if (re-search-backward ring-separator nil t) + (match-end 0) + (point-min))) + (when (and ring-file-prefix + (looking-at ring-file-prefix)) + ;; Skip zsh extended_history stamps + (goto-char (match-end 0))) + (setq start (point)) (setq history (buffer-substring start end)) - (goto-char start) (when (and (not (string-match history-ignore history)) (or (null ignoredups) (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 @@ (choice :tag "Style" (const :tag "Raised" released-button) (const :tag "Sunken" pressed-button) + (const :tag "Flat" flat-button) (const :tag "None" nil)))) ;; filter to make value suitable for customize (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 ;; (directory :format "%v")))) (load-prefer-newer lisp boolean "24.4") ;; minibuf.c - (minibuffer-follows-selected-frame minibuffer boolean "28.1") + (minibuffer-follows-selected-frame + minibuffer (choice (const :tag "Always" t) + (const :tag "When used" hybrid) + (const :tag "Never" nil)) + "28.1") (enable-recursive-minibuffers minibuffer boolean) (history-length minibuffer (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 ;; No longer true: ;; "See `send-mail-function' in sendmail.el for an example." + ;; Defvar it so as to mark it special, etc (bug#25770). + (internal--define-uninitialized-variable symbol) + ;; Until the var is actually initialized, it is kept unbound. ;; This seemed to be at least as good as setting it to an arbitrary ;; value like nil (evaluating `value' is not an option because it @@ -237,6 +240,8 @@ The following keywords are meaningful: :type VALUE should be a widget type for editing the symbol's value. Every `defcustom' should specify a value for this keyword. + See Info node `(elisp) Customization Types' for a list of + base types and useful composite types. :options VALUE should be a list of valid members of the widget type. :initialize VALUE should be a function used to initialize the @@ -778,8 +783,7 @@ Return non-nil if the `customized-value' property actually changed." Use the :set function to do so. This is useful for customizable options that are defined before their standard value can really be computed. E.g. dumped variables whose default depends on run-time information." - ;; If it has never been set at all, defvar it so as to mark it - ;; special, etc (bug#25770). This means we are initializing + ;; We are initializing ;; the variable, and normally any :set function would not apply. ;; For custom-initialize-delay, however, it is documented that "the ;; (delayed) initialization is performed with the :set function". @@ -787,11 +791,10 @@ E.g. dumped variables whose default depends on run-time information." ;; custom-initialize-delay but needs the :set function custom-set-minor-mode ;; to also run during initialization. So, long story short, we ;; always do the funcall step, even if symbol was not bound before. - (or (default-boundp symbol) - (eval `(defvar ,symbol nil))) ; reset below, so any value is fine (funcall (or (get symbol 'custom-set) #'set-default) symbol - (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) + (eval (car (or (get symbol 'saved-value) + (get symbol 'standard-value)))))) ;;; 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." ;;; Internal functions. ;; Fixme: This should probably use `thing-at-point'. -- fx -(define-obsolete-function-alias 'dired-filename-at-point +(define-obsolete-function-alias 'dired-file-name-at-point #'dired-x-guess-file-name-at-point "28.1") (defun dired-x-guess-file-name-at-point () "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." (lambda ,args ,@body)))) (eval-and-compile ;Needed while compiling the cl-defmethod calls below! - (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el. - "Check which of the symbols VARS appear in SEXP." - (let ((res '())) - (while (consp sexp) - (dolist (var (cl--generic-fgrep vars (pop sexp))) - (unless (memq var res) (push var res)))) - (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) - res)) - (defun cl--generic-split-args (args) "Return (SPEC-ARGS . PLAIN-ARGS)." (let ((plain-args ()) @@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY." ;; is used. ;; FIXME: Also, optimize the case where call-next-method is ;; only called with explicit arguments. - (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) + (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))) (cons (not (not uses-cnm)) `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) ,@(car parsed-body) - ,(if (not (memq nmp uses-cnm)) + ,(if (not (assq nmp uses-cnm)) nbody `(let ((,nmp (lambda () (cl--generic-isnot-nnm-p ,cnm)))) @@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (lambda (,@fixedargs &rest args) (let ,bindings (apply (cl--generic-with-memoization - (gethash ,tag-exp method-cache) - (cl--generic-cache-miss - generic ',dispatch-arg dispatches-left methods - ,(if (cdr typescodes) - `(append ,@typescodes) (car typescodes)))) + (gethash ,tag-exp method-cache) + (cl--generic-cache-miss + generic ',dispatch-arg dispatches-left methods + ,(if (cdr typescodes) + `(append ,@typescodes) (car typescodes)))) ,@fixedargs args))))))))) (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." (if (not (eq (car-safe specializer) 'head)) (cl-call-next-method) (cl--generic-with-memoization - (gethash (cadr specializer) cl--generic-head-used) specializer) + (gethash (cadr specializer) cl--generic-head-used) + specializer) (list cl--generic-head-generalizer))) (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. ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) +(defun cl--self-tco (var fargs body) + ;; This tries to "optimize" tail calls for the specific case + ;; of recursive self-calls by replacing them with a `while' loop. + ;; It is quite far from a general tail-call optimization, since it doesn't + ;; even handle mutually recursive functions. + (letrec + ((done nil) ;; Non-nil if some TCO happened. + (retvar (make-symbol "retval")) + (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s + (make-symbol (symbol-name s)))) + fargs)) + (opt-exps (lambda (exps) ;; `exps' is in tail position! + (append (butlast exps) + (list (funcall opt (car (last exps))))))) + (opt + (lambda (exp) ;; `exp' is in tail position! + (pcase exp + ;; FIXME: Optimize `apply'? + (`(funcall ,(pred (eq var)) . ,aargs) + ;; This is a self-recursive call in tail position. + (let ((sets nil) + (fargs ofargs)) + (while fargs + (pcase (pop fargs) + ('&rest + (push (pop fargs) sets) + (push `(list . ,aargs) sets) + ;; (cl-assert (null fargs)) + ) + ('&optional nil) + (farg + (push farg sets) + (push (pop aargs) sets)))) + (setq done t) + `(progn (setq . ,(nreverse sets)) + :recurse))) + (`(progn . ,exps) `(progn . ,(funcall opt-exps exps))) + (`(if ,cond ,then . ,else) + `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else))) + (`(cond . ,conds) + (let ((cs '())) + (while conds + (pcase (pop conds) + (`(,exp) + (push (if conds + ;; This returns the value of `exp' but it's + ;; only in tail position if it's the + ;; last condition. + `((setq ,retvar ,exp) nil) + `(,(funcall opt exp))) + cs)) + (exps + (push (funcall opt-exps exps) cs)))) + (if (eq t (caar cs)) + `(cond . ,(nreverse cs)) + `(cond ,@(nreverse cs) (t (setq ,retvar nil)))))) + ((and `(,(or 'let 'let*) ,bindings . ,exps) + (guard + ;; Note: it's OK for this `let' to shadow any + ;; of the formal arguments since we will only + ;; setq the fresh new `ofargs' vars instead ;-) + (let ((shadowings + (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))) + ;; If `var' is shadowed, then it clearly can't be + ;; tail-called any more. + (not (memq var shadowings))))) + `(,(car exp) ,bindings . ,(funcall opt-exps exps))) + (_ + `(progn (setq ,retvar ,exp) nil)))))) + + (let ((optimized-body (funcall opt-exps body))) + (if (not done) + (cons fargs body) + ;; We use two sets of vars: `ofargs' and `fargs' because we need + ;; to be careful that if a closure captures a formal argument + ;; in one iteration, it needs to capture a different binding + ;; then that of other iterations, e.g. + (cons + ofargs + `((let (,retvar) + (while (let ,(delq nil + (cl-mapcar + (lambda (a oa) + (unless (memq a cl--lambda-list-keywords) + (list a oa))) + fargs ofargs)) + . ,optimized-body)) + ,retvar))))))) + ;;;###autoload (defmacro cl-labels (bindings &rest body) - "Make local (recursive) function definitions. -Each definition can take the form (FUNC ARGLIST BODY...) where + "Make local (recursive) function definitions. ++BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where FUNC is the function name, ARGLIST its arguments, and BODY the forms of the function body. FUNC is defined in any BODY, as well as FORM, so you can write recursive and mutually recursive @@ -2075,17 +2164,33 @@ details. (let ((binds ()) (newenv macroexpand-all-environment)) (dolist (binding bindings) (let ((var (make-symbol (format "--cl-%s--" (car binding))))) - (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) + (push (cons var (cdr binding)) binds) (push (cons (car binding) (lambda (&rest args) (if (eq (car args) cl--labels-magic) (list cl--labels-magic var) (cl-list* 'funcall var args)))) newenv))) - (macroexpand-all `(letrec ,(nreverse binds) ,@body) - ;; Don't override lexical-let's macro-expander. - (if (assq 'function newenv) newenv - (cons (cons 'function #'cl--labels-convert) newenv))))) + ;; Don't override lexical-let's macro-expander. + (unless (assq 'function newenv) + (push (cons 'function #'cl--labels-convert) newenv)) + ;; Perform self-tail call elimination. + (setq binds (mapcar + (lambda (bind) + (pcase-let* + ((`(,var ,sargs . ,sbody) bind) + (`(function (lambda ,fargs . ,ebody)) + (macroexpand-all `(cl-function (lambda ,sargs . ,sbody)) + newenv)) + (`(,ofargs . ,obody) + (cl--self-tco var fargs ebody))) + `(,var (function (lambda ,ofargs . ,obody))))) + (nreverse binds))) + `(letrec ,binds + . ,(macroexp-unprogn + (macroexpand-all + (macroexp-progn body) + newenv))))) ;; The following ought to have a better definition for use with newer ;; byte compilers. @@ -3413,8 +3518,8 @@ macro that returns its `&whole' argument." (put y 'side-effect-free t)) ;;; Things that are inline. -(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany - cl-notevery cl-revappend cl-nreconc gethash)) +(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend + cl-nreconc gethash)) ;;; Things that are side-effect-free. (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." old))) +;;; Named object + +(defclass eieio-named () + ((object-name :initarg :object-name :initform nil)) + "Object with a name." + :abstract t) + +(cl-defmethod eieio-object-name-string ((obj eieio-named)) + "Return a string which is OBJ's name." + (or (slot-value obj 'object-name) + (cl-call-next-method))) + +(cl-defgeneric eieio-object-set-name-string (obj name) + "Set the string which is OBJ's NAME." + (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1")) + (cl-check-type name string) + (setf (gethash obj eieio--object-names) name)) +(define-obsolete-function-alias + 'object-set-name-string 'eieio-object-set-name-string "24.4") + +(with-suppressed-warnings ((obsolete eieio-object-set-name-string)) + (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name) + "Set the string which is OBJ's NAME." + (cl-check-type name string) + (eieio-oset obj 'object-name name))) + +(cl-defmethod clone ((obj eieio-named) &rest params) + "Clone OBJ, initializing `:parent' to OBJ. +All slots are unbound, except those initialized with PARAMS." + (let* ((newname (and (stringp (car params)) (pop params))) + (nobj (apply #'cl-call-next-method obj params)) + (nm (slot-value nobj 'object-name))) + (eieio-oset nobj 'object-name + (or newname + (if (equal nm (slot-value obj 'object-name)) + (save-match-data + (if (and nm (string-match "-\\([0-9]+\\)" nm)) + (let ((num (1+ (string-to-number + (match-string 1 nm))))) + (concat (substring nm 0 (match-beginning 0)) + "-" (int-to-string num))) + (concat nm "-1"))) + nm))) + nobj)) + +(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args) + (if (not (stringp (car args))) + (cl-call-next-method) + (funcall (if eieio-backward-compatibility #'ignore #'message) + "Obsolete: name passed without :object-name to %S constructor" + class) + (apply #'cl-call-next-method class :object-name args))) + ;;; eieio-persistent ;; ;; For objects which must save themselves to disk. Provides an @@ -264,12 +317,17 @@ objects found there." (:method ((objclass (subclass eieio-default-superclass)) inputlist) - (let ((slots (if (stringp (car inputlist)) - ;; Earlier versions of `object-write' added a - ;; string name for the object, now obsolete. - (cdr inputlist) - inputlist)) - (createslots nil)) + (let* ((name nil) + (slots (if (stringp (car inputlist)) + (progn + ;; Earlier versions of `object-write' added a + ;; string name for the object, now obsolete. + ;; Save as 'name' in case this object is subclass + ;; of eieio-named with no :object-name slot specified. + (setq name (car inputlist)) + (cdr inputlist)) + inputlist)) + (createslots nil)) ;; If OBJCLASS is an eieio autoload object, then we need to ;; load it (we don't need the return value). (eieio--full-class-object objclass) @@ -286,7 +344,17 @@ objects found there." (setq slots (cdr (cdr slots)))) - (apply #'make-instance objclass (nreverse createslots))))) + (let ((newobj (apply #'make-instance objclass (nreverse createslots)))) + + ;; Check for special case of subclass of `eieio-named', and do + ;; name assignment. + (when (and eieio-backward-compatibility + (object-of-class-p newobj 'eieio-named) + (not (oref newobj object-name)) + name) + (oset newobj object-name name)) + + newobj)))) (defun eieio-persistent-fix-value (proposed-value) "Fix PROPOSED-VALUE. @@ -408,59 +476,6 @@ instance." ;; It should also set up some hooks to help it keep itself up to date. -;;; Named object - -(defclass eieio-named () - ((object-name :initarg :object-name :initform nil)) - "Object with a name." - :abstract t) - -(cl-defmethod eieio-object-name-string ((obj eieio-named)) - "Return a string which is OBJ's name." - (or (slot-value obj 'object-name) - (cl-call-next-method))) - -(cl-defgeneric eieio-object-set-name-string (obj name) - "Set the string which is OBJ's NAME." - (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1")) - (cl-check-type name string) - (setf (gethash obj eieio--object-names) name)) -(define-obsolete-function-alias - 'object-set-name-string 'eieio-object-set-name-string "24.4") - -(with-suppressed-warnings ((obsolete eieio-object-set-name-string)) - (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name) - "Set the string which is OBJ's NAME." - (cl-check-type name string) - (eieio-oset obj 'object-name name))) - -(cl-defmethod clone ((obj eieio-named) &rest params) - "Clone OBJ, initializing `:parent' to OBJ. -All slots are unbound, except those initialized with PARAMS." - (let* ((newname (and (stringp (car params)) (pop params))) - (nobj (apply #'cl-call-next-method obj params)) - (nm (slot-value nobj 'object-name))) - (eieio-oset nobj 'object-name - (or newname - (if (equal nm (slot-value obj 'object-name)) - (save-match-data - (if (and nm (string-match "-\\([0-9]+\\)" nm)) - (let ((num (1+ (string-to-number - (match-string 1 nm))))) - (concat (substring nm 0 (match-beginning 0)) - "-" (int-to-string num))) - (concat nm "-1"))) - nm))) - nobj)) - -(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args) - (if (not (stringp (car args))) - (cl-call-next-method) - (funcall (if eieio-backward-compatibility #'ignore #'message) - "Obsolete: name passed without :object-name to %S constructor" - class) - (apply #'cl-call-next-method class :object-name args))) - (provide 'eieio-base) 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." ("\\(\\\\\\)\\([^\"\\]\\)" (1 (elisp--font-lock-backslash) prepend)) ;; Words inside ‘’ and `' tend to be symbol names. - (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)" - lisp-mode-symbol-regexp "\\)['’]") + (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]") (1 font-lock-constant-face prepend)) ;; Constant values. (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") @@ -507,8 +506,7 @@ This will generate compile-time constants from BINDINGS." (,(concat "(" cl-errs-re "\\_>") (1 font-lock-warning-face)) ;; Words inside ‘’ and `' tend to be symbol names. - (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)" - lisp-mode-symbol-regexp "\\)['’]") + (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]") (1 font-lock-constant-face prepend)) ;; Uninterned symbols, e.g., (defpackage #:my-package ...) ;; 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." v (list 'quote v))) +(defun macroexp--fgrep (bindings sexp) + "Return those of the BINDINGS which might be used in SEXP. +It is used as a poor-man's \"free variables\" test. It differs from a true +test of free variables in the following ways: +- It does not distinguish variables from functions, so it can be used + both to detect whether a given variable is used by SEXP and to + detect whether a given function is used by SEXP. +- It does not actually know ELisp syntax, so it only looks for the presence + of symbols in SEXP and can't distinguish if those symbols are truly + references to the given variable (or function). That can make the result + include bindings which actually aren't used. +- For the same reason it may cause the result to fail to include bindings + which will be used if SEXP is not yet fully macro-expanded and the + use of the binding will only be revealed by macro expansion." + (let ((res '())) + (while (and (consp sexp) bindings) + (dolist (binding (macroexp--fgrep bindings (pop sexp))) + (push binding res) + (setq bindings (remove binding bindings)))) + (if (or (vectorp sexp) (byte-code-function-p sexp)) + ;; With backquote, code can appear within vectors as well. + ;; This wouldn't be needed if we `macroexpand-all' before + ;; calling macroexp--fgrep, OTOH. + (macroexp--fgrep bindings (mapcar #'identity sexp)) + (let ((tmp (assq sexp bindings))) + (if tmp + (cons tmp res) + res))))) + ;;; Load-time macro-expansion. ;; 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'. (seen '()) (codegen (lambda (code vars) - (let ((vars (pcase--fgrep vars code)) + (let ((vars (macroexp--fgrep vars code)) (prev (assq code seen))) (if (not prev) (let ((res (pcase-codegen code vars))) @@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'. ;; occurrences of this leaf since it's small. (lambda (code vars) (pcase-codegen code - (pcase--fgrep vars code))) + (macroexp--fgrep vars code))) codegen) (cdr case) vars)))) @@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; run, but we don't have the environment in which `pat' will ;; run, so we can't do a reliable verification. But let's try ;; and catch at least the easy cases such as (bug#14773). - (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) + (not (macroexp--fgrep (mapcar #'car vars) (cadr upat))))) '(:pcase--succeed . :pcase--fail)) ((and (eq 'pred (car upat)) (let ((otherpred @@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form: '(nil . :pcase--fail) '(:pcase--fail . nil)))))) -(defun pcase--fgrep (bindings sexp) - "Return those of the BINDINGS which might be used in SEXP." - (let ((res '())) - (while (and (consp sexp) bindings) - (dolist (binding (pcase--fgrep bindings (pop sexp))) - (push binding res) - (setq bindings (remove binding bindings)))) - (if (vectorp sexp) - ;; With backquote, code can appear within vectors as well. - ;; This wouldn't be needed if we `macroexpand-all' before - ;; calling pcase--fgrep, OTOH. - (pcase--fgrep bindings (mapcar #'identity sexp)) - (let ((tmp (assq sexp bindings))) - (if tmp - (cons tmp res) - res))))) - (defun pcase--self-quoting-p (upat) (or (keywordp upat) (integerp upat) (stringp upat))) @@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form: `(,fun ,arg) (let* (;; `env' is an upper bound on the bindings we need. (env (mapcar (lambda (x) (list (car x) (cdr x))) - (pcase--fgrep vars fun))) + (macroexp--fgrep vars fun))) (call (progn (when (assq arg env) ;; `arg' is shadowed by `env'. @@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form: "Build an expression that will evaluate EXP." (let* ((found (assq exp vars))) (if found (cdr found) - (let* ((env (pcase--fgrep vars exp))) + (let* ((env (macroexp--fgrep vars exp))) (if env (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) 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." (insert (propertize "(" 'shortdoc-function t)) (if (plist-get data :no-manual) - (insert (symbol-name function)) + (insert-text-button + (symbol-name function) + 'face 'button + 'action (lambda (_) + (describe-function function)) + 'follow-link t + 'help-echo (purecopy "mouse-1, RET: describe function")) (insert-text-button (symbol-name function) 'face 'button 'action (lambda (_) - (info-lookup-symbol function 'emacs-lisp-mode)))) + (info-lookup-symbol function 'emacs-lisp-mode)) + 'follow-link t + 'help-echo (purecopy "mouse-1, RET: show \ +function's documentation in the Info manual"))) (setq arglist-start (point)) (insert ")\n") ;; 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." :group 'erc-services :type 'boolean) +(defcustom erc-use-auth-source-for-nickserv-password nil + "Query auth-source for a password when identifiying to NickServ. +This option has an no effect if `erc-prompt-for-nickserv-password' +is non-nil, and passwords from `erc-nickserv-passwords' take +precedence." + :version "28.1" + :group 'erc-services + :type 'boolean) + (defcustom erc-nickserv-passwords nil "Passwords used when identifying to NickServ automatically. +`erc-prompt-for-nickserv-password' must be nil for these +passwords to be used. Example of use: (setq erc-nickserv-passwords @@ -375,7 +386,8 @@ Make sure it is the real NickServ for this network. If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the password for this nickname, otherwise try to send it automatically." (unless (and (null erc-nickserv-passwords) - (null erc-prompt-for-nickserv-password)) + (null erc-prompt-for-nickserv-password) + (null erc-use-auth-source-for-nickserv-password)) (let* ((network (erc-network)) (sender (erc-nickserv-alist-sender network)) (identify-regex (erc-nickserv-alist-regexp network)) @@ -394,30 +406,49 @@ password for this nickname, otherwise try to send it automatically." (defun erc-nickserv-identify-on-connect (_server nick) "Identify to Nickserv after the connection to the server is established." (unless (or (and (null erc-nickserv-passwords) - (null erc-prompt-for-nickserv-password)) - (and (eq erc-nickserv-identify-mode 'both) - (erc-nickserv-alist-regexp (erc-network)))) + (null erc-prompt-for-nickserv-password) + (null erc-use-auth-source-for-nickserv-password)) + (and (eq erc-nickserv-identify-mode 'both) + (erc-nickserv-alist-regexp (erc-network)))) (erc-nickserv-call-identify-function nick))) (defun erc-nickserv-identify-on-nick-change (nick _old-nick) "Identify to Nickserv whenever your nick changes." (unless (or (and (null erc-nickserv-passwords) - (null erc-prompt-for-nickserv-password)) - (and (eq erc-nickserv-identify-mode 'both) - (erc-nickserv-alist-regexp (erc-network)))) + (null erc-prompt-for-nickserv-password) + (null erc-use-auth-source-for-nickserv-password)) + (and (eq erc-nickserv-identify-mode 'both) + (erc-nickserv-alist-regexp (erc-network)))) (erc-nickserv-call-identify-function nick))) +(defun erc-nickserv-get-password (nickname) + "Return the password for NICKNAME from configured sources. + +It uses `erc-nickserv-passwords' and additionally auth-source +when `erc-use-auth-source-for-nickserv-password' is not nil." + (or + (when erc-nickserv-passwords + (cdr (assoc nickname + (nth 1 (assoc (erc-network) + erc-nickserv-passwords))))) + (when erc-use-auth-source-for-nickserv-password + (let* ((secret (nth 0 (auth-source-search + :max 1 :require '(:secret) + :host (erc-with-server-buffer erc-session-server) + :port (format ; ensure we have a string + "%s" (erc-with-server-buffer erc-session-port)) + :user nickname)))) + (when secret + (let ((passwd (plist-get secret :secret))) + (if (functionp passwd) (funcall passwd) passwd))))))) + (defun erc-nickserv-call-identify-function (nickname) "Call `erc-nickserv-identify'. Either call it interactively or run it with NICKNAME's password, depending on the value of `erc-prompt-for-nickserv-password'." (if erc-prompt-for-nickserv-password (call-interactively 'erc-nickserv-identify) - (when erc-nickserv-passwords - (erc-nickserv-identify - (cdr (assoc nickname - (nth 1 (assoc (erc-network) - erc-nickserv-passwords)))))))) + (erc-nickserv-identify (erc-nickserv-get-password nickname)))) (defvar erc-auto-discard-away) @@ -451,6 +482,7 @@ When called interactively, read the password using `read-passwd'." (provide 'erc-services) + ;;; erc-services.el ends here ;; ;; 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:- Signal an error if the final event isn't the same type as the first one." (let ((initial-event-type (event-basic-type event))) (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) - (setq event (read-event))) + (setq event (read--potential-mouse-event))) (or (eq initial-event-type (event-basic-type event)) (error ""))) 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." ;; blink-cursor-end is not added to pre-command-hook. (setq blink-cursor-blinks-done 1) (blink-cursor--start-timer) - (add-hook 'pre-command-hook 'blink-cursor-end) + (add-hook 'pre-command-hook #'blink-cursor-end) (internal-show-cursor nil nil))) (defun blink-cursor-timer-function () @@ -2572,14 +2572,14 @@ command starts, by installing a pre-command hook." (when (and (> blink-cursor-blinks 0) (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) (blink-cursor-suspend) - (add-hook 'post-command-hook 'blink-cursor-check))) + (add-hook 'post-command-hook #'blink-cursor-check))) (defun blink-cursor-end () "Stop cursor blinking. This is installed as a pre-command hook by `blink-cursor-start'. When run, it cancels the timer `blink-cursor-timer' and removes itself as a pre-command hook." - (remove-hook 'pre-command-hook 'blink-cursor-end) + (remove-hook 'pre-command-hook #'blink-cursor-end) (internal-show-cursor nil t) (when blink-cursor-timer (cancel-timer blink-cursor-timer) @@ -2648,7 +2648,7 @@ terminals, cursor blinking is controlled by the terminal." (when blink-cursor-mode (add-function :after after-focus-change-function #'blink-cursor--rescan-frames) (add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames) - (blink-cursor--start-idle-timer))) + (blink-cursor-check))) ;; 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.") '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw answered before deleted draft flagged on since recent seen sentbefore senton sentsince unanswered undeleted undraft unflagged unkeyword - unseen all) + unseen all old new or not) "Known IMAP search keys.") ;; imap interface @@ -1072,10 +1072,11 @@ Responsible for handling and, or, and parenthetical expressions.") ;; A bit of backward-compatibility slash convenience: if the ;; query string doesn't start with any known IMAP search ;; keyword, assume it is a "TEXT" search. - (unless (and (string-match "\\`[^[:blank:]]+" q-string) - (memql (intern-soft (downcase - (match-string 0 q-string))) - gnus-search-imap-search-keys)) + (unless (or (looking-at "(") + (and (string-match "\\`[^[:blank:]]+" q-string) + (memql (intern-soft (downcase + (match-string 0 q-string))) + gnus-search-imap-search-keys))) (setq q-string (concat "TEXT " q-string))) ;; 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." (,shell-command-buffer-name 1.0))) (bug (vertical 1.0 - (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) ("*Gnus Bug*" 1.0 point))) (score-trace (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." (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" "All headers that match this regexp will be deleted when forwarding a message. -This variable is only consulted when forwarding \"normally\", not -when forwarding as MIME or the like. +This variable is not consulted when forwarding encrypted messages +and `message-forward-show-mml' is `best'. This may also be a list of regexps." :version "21.1" @@ -7638,7 +7638,8 @@ Optional DIGEST will use digest to forward." message-forward-included-headers) t nil t))))) -(defun message-forward-make-body-mime (forward-buffer &optional beg end) +(defun message-forward-make-body-mime (forward-buffer &optional beg end + remove-headers) (let ((b (point))) (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") (save-restriction @@ -7648,6 +7649,8 @@ Optional DIGEST will use digest to forward." (goto-char (point-min)) (when (looking-at "From ") (replace-match "X-From-Line: ")) + (when remove-headers + (message-remove-ignored-headers (point-min) (point-max))) (goto-char (point-max))) (insert "<#/part>\n") ;; Consider there is no illegible text. @@ -7786,7 +7789,8 @@ is for the internal use." (message-signed-or-encrypted-p) (error t)))))) (message-forward-make-body-mml forward-buffer) - (message-forward-make-body-mime forward-buffer)) + (message-forward-make-body-mime + forward-buffer nil nil (not (eq message-forward-show-mml 'best)))) (message-forward-make-body-plain forward-buffer))) (message-position-point)) 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." (when (and (mm-handle-buffer handle) (buffer-name (mm-handle-buffer handle))) (with-temp-buffer - (if (and (eq (mm-handle-encoding handle) '8bit) - (with-current-buffer (mm-handle-buffer handle) - enable-multibyte-characters)) - ;; Due to unfortunate historical reasons, we may have a - ;; multibyte buffer here, but if it's using an 8bit - ;; Content-Transfer-Encoding, then work around that by - ;; just ignoring the situation. - (insert-buffer-substring (mm-handle-buffer handle)) - ;; Do the decoding. - (mm-disable-multibyte) - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle))) + (mm-disable-multibyte) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) ,@forms)))) (put 'mm-with-part 'lisp-indent-function 1) (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'.") (throw 'return nil)) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents nnmaildir-article-file-name)) + (let ((coding-system-for-read mm-text-coding-system)) + (mm-insert-file-contents nnmaildir-article-file-name))) (cons gname num-msgid)))) (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." (insert-text-button (symbol-name group) 'action (lambda (_) - (shortdoc-display-group group)))) + (shortdoc-display-group group)) + 'follow-link t + 'help-echo (purecopy "mouse-1, RET: show documentation group"))) groups) (insert (if (= (length groups) 1) " 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: "\\(symbol\\|program\\|property\\)\\|" ; Don't link "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" "[ \t\n]+\\)?" - ;; Note starting with word-syntax character: - "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]")) + "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]")) "Regexp matching doc string references to symbols. The 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." "Regexp search%s" (car Info-search-history) (if case-fold-search "" " case-sensitively")) nil 'Info-search-history))) - (deactivate-mark) (when (equal regexp "") (setq regexp (car Info-search-history))) (when regexp @@ -2066,6 +2065,7 @@ If DIRECTION is `backward', search in the reverse direction." (< found opoint-max)) ;; Search landed in the same node (goto-char found) + (deactivate-mark) (widen) (goto-char found) (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." :image '(isearch-tool-bar-image "left-arrow"))) map)) -;; Note: Before adding more key bindings to this map, please keep in -;; mind that any unbound key exits Isearch and runs the command bound -;; to it in the local or global map. So in effect every key unbound -;; in this map is implicitly bound. (defvar minibuffer-local-isearch-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) @@ -2498,6 +2494,21 @@ If search string is empty, just beep." (unless isearch-mode (isearch-mode t)) (isearch-yank-string (current-kill 0))) +(defun isearch-yank-from-kill-ring () + "Read a string from the `kill-ring' and append it to the search string." + (interactive) + (with-isearch-suspended + (let ((string (read-from-kill-ring))) + (if (and isearch-case-fold-search + (eq 'not-yanks search-upper-case)) + (setq string (downcase string))) + (if isearch-regexp (setq string (regexp-quote string))) + (setq isearch-yank-flag t) + (setq isearch-new-string (concat isearch-string string) + isearch-new-message (concat isearch-message + (mapconcat 'isearch-text-char-description + string "")))))) + (defun isearch-yank-pop () "Replace just-yanked search string with previously killed string. Unlike `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." (interactive) (if (not (memq last-command '(isearch-yank-kill isearch-yank-pop isearch-yank-pop-only))) - ;; Yank string from kill-ring-browser. - (with-isearch-suspended - (let ((string (read-from-kill-ring))) - (if (and isearch-case-fold-search - (eq 'not-yanks search-upper-case)) - (setq string (downcase string))) - (if isearch-regexp (setq string (regexp-quote string))) - (setq isearch-yank-flag t) - (setq isearch-new-string (concat isearch-string string) - isearch-new-message (concat isearch-message - (mapconcat 'isearch-text-char-description - string ""))))) + (isearch-yank-from-kill-ring) (isearch-pop-state) (isearch-yank-string (current-kill 1)))) -(defun isearch-yank-pop-only () +(defun isearch-yank-pop-only (&optional arg) "Replace just-yanked search string with previously killed string. Unlike `isearch-yank-pop', when this command is called not immediately after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops the last killed string instead of activating the minibuffer to read -a string from the `kill-ring' as `yank-pop' does." - (interactive) - (if (not (memq last-command '(isearch-yank-kill - isearch-yank-pop isearch-yank-pop-only))) - ;; Fall back on `isearch-yank-kill' for the benefits of people - ;; who are used to the old behavior of `M-y' in isearch mode. - ;; In future, `M-y' could be changed from `isearch-yank-pop-only' - ;; to `isearch-yank-pop' that uses the kill-ring-browser. - (isearch-yank-kill) +a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u +always reads a string from the `kill-ring' using the minibuffer." + (interactive "P") + (cond + ((equal arg '(4)) + (isearch-yank-from-kill-ring)) + ((not (memq last-command '(isearch-yank-kill + isearch-yank-pop isearch-yank-pop-only))) + ;; Fall back on `isearch-yank-kill' for the benefits of people + ;; who are used to the old behavior of `M-y' in isearch mode. + ;; In future, `M-y' could be changed from `isearch-yank-pop-only' + ;; to `isearch-yank-pop' that uses the kill-ring-browser. + (isearch-yank-kill)) + (t (isearch-pop-state) - (isearch-yank-string (current-kill 1)))) + (isearch-yank-string (current-kill 1))))) (defun isearch-yank-x-selection () "Pull current X selection into search string." @@ -2997,7 +3002,7 @@ See more for options in `search-exit-option'." ((and (eq (car-safe main-event) 'down-mouse-1) (window-minibuffer-p (posn-window (event-start main-event)))) ;; Swallow the up-event. - (read-event) + (read--potential-mouse-event) (setq this-command 'isearch-edit-string)) ;; Don't terminate the search for motion commands. ((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.") ;; A better solution would be to make deactivate-mark buffer-local ;; (or to turn it into a list of buffers, ...), but in the mean time, ;; this should do the trick in most cases. - (setq deactivate-mark nil) - (throw 'exit nil)) + (when (innermost-minibuffer-p) + (setq deactivate-mark nil) + (throw 'exit nil)) + (error "%s" "Not in most nested minibuffer")) (defun self-insert-and-exit () "Terminate minibuffer input." @@ -2394,7 +2396,7 @@ The completion method is determined by `completion-at-point-functions'." ;;; Key bindings. (let ((map minibuffer-local-map)) - (define-key map "\C-g" 'abort-recursive-edit) + (define-key map "\C-g" 'abort-minibuffers) (define-key map "\M-<" 'minibuffer-beginning-of-buffer) (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: ;; Don't change the mouse pointer shape while we drag. (setq track-mouse 'dragging) (while (progn - (setq event (read-event) + (setq event (read--potential-mouse-event) end (event-end event) row (cdr (posn-col-row end)) col (car (posn-col-row end))) @@ -286,7 +286,7 @@ To test this function, evaluate: window-last-col (- (window-width) 2)) (track-mouse (while (progn - (setq event (read-event) + (setq event (read--potential-mouse-event) end (event-end event) row (cdr (posn-col-row end)) 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." (let (event end end-point) (track-mouse (while (progn - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (or (mouse-movement-p event) (memq (car-safe event) '(switch-frame select-window)))) 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." (mapc (lambda (info) (let ((local-ip (nth 1 info)) - (mask (nth 2 info))) + (mask (nth 3 info))) (when (nsm-network-same-subnet (substring local-ip 0 -1) (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." `(,tramp-adb-method (tramp-login-program ,tramp-adb-program) (tramp-login-args (("shell"))) + (tramp-direct-async t) (tramp-tmpdir "/data/local/tmp") (tramp-default-port 5555))) @@ -895,8 +896,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; terminated. (defun tramp-adb-handle-make-process (&rest args) "Like `make-process' for Tramp files. -If connection property \"direct-async-process\" is non-nil, an -alternative implementation will be used." +If method parameter `tramp-direct-async' and connection property +\"direct-async-process\" are non-nil, an alternative +implementation will be used." (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (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'.") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) + (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) @@ -183,6 +184,7 @@ The string is used in `tramp-methods'.") ("-e" "none") ("-t" "-t") ("%h") ("%l"))) (tramp-async-args (("-q"))) + (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) @@ -197,6 +199,7 @@ The string is used in `tramp-methods'.") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) + (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) @@ -227,6 +230,7 @@ The string is used in `tramp-methods'.") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) + (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")))) @@ -237,6 +241,7 @@ The string is used in `tramp-methods'.") ("-e" "none") ("-t" "-t") ("%h") ("%l"))) (tramp-async-args (("-q"))) + (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")))) @@ -2601,7 +2606,7 @@ The method used must be an out-of-band method." (t nil))))))))) (defun tramp-sh-handle-insert-directory - (filename switches &optional wildcard full-directory-p) + (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (setq filename (expand-file-name filename)) (unless switches (setq switches "")) @@ -2636,66 +2641,63 @@ The method used must be an out-of-band method." v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" switches filename (if wildcard "yes" "no") (if full-directory-p "yes" "no")) - ;; If `full-directory-p', we just say `ls -l FILENAME'. - ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. + ;; If `full-directory-p', we just say `ls -l FILENAME'. Else we + ;; chdir to the parent directory, then say `ls -ld BASENAME'. (if full-directory-p (tramp-send-command - v - (format "%s %s %s 2>%s" - (tramp-get-ls-command v) - switches - (if wildcard - localname - (tramp-shell-quote-argument (concat localname "."))) - (tramp-get-remote-null-device v))) + v (format "%s %s %s 2>%s" + (tramp-get-ls-command v) + switches + (if wildcard + localname + (tramp-shell-quote-argument (concat localname "."))) + (tramp-get-remote-null-device v))) (tramp-barf-unless-okay - v - (format "cd %s" (tramp-shell-quote-argument - (tramp-run-real-handler - #'file-name-directory (list localname)))) + v (format "cd %s" (tramp-shell-quote-argument + (tramp-run-real-handler + #'file-name-directory (list localname)))) "Couldn't `cd %s'" (tramp-shell-quote-argument (tramp-run-real-handler #'file-name-directory (list localname)))) (tramp-send-command - v - (format "%s %s %s 2>%s" - (tramp-get-ls-command v) - switches - (if (or wildcard - (zerop (length - (tramp-run-real-handler - #'file-name-nondirectory (list localname))))) - "" - (tramp-shell-quote-argument - (tramp-run-real-handler - #'file-name-nondirectory (list localname)))) - (tramp-get-remote-null-device v)))) - - (save-restriction - (let ((beg (point)) - (emc enable-multibyte-characters)) - (narrow-to-region (point) (point)) - ;; We cannot use `insert-buffer-substring' because the Tramp - ;; buffer changes its contents before insertion due to calling - ;; `expand-file-name' and alike. - (insert - (with-current-buffer (tramp-get-buffer v) - (buffer-string))) - - ;; Check for "--dired" output. We must enable unibyte - ;; strings, because the "--dired" output counts in bytes. - (set-buffer-multibyte nil) + v (format "%s %s %s 2>%s" + (tramp-get-ls-command v) + switches + (if (or wildcard + (zerop (length + (tramp-run-real-handler + #'file-name-nondirectory (list localname))))) + "" + (tramp-shell-quote-argument + (tramp-run-real-handler + #'file-name-nondirectory (list localname)))) + (tramp-get-remote-null-device v)))) + + (let ((beg-marker (copy-marker (point) nil)) + (end-marker (copy-marker (point) t)) + (emc enable-multibyte-characters)) + ;; We cannot use `insert-buffer-substring' because the Tramp + ;; buffer changes its contents before insertion due to calling + ;; `expand-file-name' and alike. + (insert (with-current-buffer (tramp-get-buffer v) (buffer-string))) + + ;; We must enable unibyte strings, because the "--dired" + ;; output counts in bytes. + (set-buffer-multibyte nil) + (save-restriction + (narrow-to-region beg-marker end-marker) + ;; Check for "--dired" output. (forward-line -2) (when (looking-at-p "//SUBDIRED//") (forward-line -1)) (when (looking-at "//DIRED//\\s-+") - (let ((databeg (match-end 0)) + (let ((beg (match-end 0)) (end (point-at-eol))) ;; Now read the numeric positions of file names. - (goto-char databeg) + (goto-char beg) (while (< (point) end) - (let ((start (+ beg (read (current-buffer)))) - (end (+ beg (read (current-buffer))))) + (let ((start (+ (point-min) (read (current-buffer)))) + (end (+ (point-min) (read (current-buffer))))) (if (memq (char-after end) '(?\n ?\ )) ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t)))))) @@ -2703,18 +2705,18 @@ The method used must be an out-of-band method." (goto-char (point-at-bol)) (while (looking-at "//") (forward-line 1) - (delete-region (match-beginning 0) (point))) - ;; Reset multibyte if needed. - (set-buffer-multibyte emc) + (delete-region (match-beginning 0) (point)))) + ;; Reset multibyte if needed. + (set-buffer-multibyte emc) + (save-restriction + (narrow-to-region beg-marker end-marker) ;; Some busyboxes are reluctant to discard colors. (unless (string-match-p "color" (tramp-get-connection-property v "ls" "")) - (save-excursion - (goto-char beg) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "")))) + (goto-char (point-min)) + (while (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match ""))) ;; Now decode what read if necessary. Stolen from `insert-directory'. (let ((coding (or coding-system-for-read @@ -2729,36 +2731,32 @@ The method used must be an out-of-band method." ;; If no coding system is specified or detection is ;; requested, detect the coding. (if (eq (coding-system-base coding) 'undecided) - (setq coding (detect-coding-region beg (point) t))) - (if (not (eq (coding-system-base coding) 'undecided)) - (save-restriction - (setq coding-no-eol - (coding-system-change-eol-conversion coding 'unix)) - (narrow-to-region beg (point)) - (goto-char (point-min)) - (while (not (eobp)) - (setq pos (point) - val (get-text-property (point) 'dired-filename)) - (goto-char (next-single-property-change - (point) 'dired-filename nil (point-max))) - ;; Force no eol conversion on a file name, so - ;; that CR is preserved. - (decode-coding-region pos (point) - (if val coding-no-eol coding)) - (if val - (put-text-property pos (point) - 'dired-filename t))))))) + (setq coding (detect-coding-region (point-min) (point) t))) + (unless (eq (coding-system-base coding) 'undecided) + (setq coding-no-eol + (coding-system-change-eol-conversion coding 'unix)) + (goto-char (point-min)) + (while (not (eobp)) + (setq pos (point) + val (get-text-property (point) 'dired-filename)) + (goto-char (next-single-property-change + (point) 'dired-filename nil (point-max))) + ;; Force no eol conversion on a file name, so that + ;; CR is preserved. + (decode-coding-region + pos (point) (if val coding-no-eol coding)) + (if val (put-text-property pos (point) 'dired-filename t)))))) ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) (goto-char (point-max)) (when (file-symlink-p filename) - (goto-char (search-backward "->" beg 'noerror))) + (goto-char (search-backward "->" (point-min) 'noerror))) (search-backward (if (directory-name-p filename) "." (file-name-nondirectory filename)) - beg 'noerror) + (point-min) 'noerror) (replace-match (file-relative-name filename) t)) ;; Try to insert the amount of free space. @@ -2769,9 +2767,11 @@ The method used must be an out-of-band method." ;; Replace "total" with "total used", to avoid confusion. (replace-match "\\1 used in directory") (end-of-line) - (insert " available " available))) + (insert " available " available)))) - (goto-char (point-max))))))) + (prog1 (goto-char end-marker) + (set-marker beg-marker nil) + (set-marker end-marker nil)))))) ;; Canonicalization of file names. @@ -2840,9 +2840,9 @@ the result will be a local, non-Tramp, file name." ;; terminated. (defun tramp-sh-handle-make-process (&rest args) "Like `make-process' for Tramp files. -STDERR can also be a file name. If connection property -\"direct-async-process\" is non-nil, an alternative -implementation will be used." +STDERR can also be a file name. If method parameter `tramp-direct-async' +and connection property \"direct-async-process\" are non-nil, an +alternative implementation will be used." (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (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: parameters to suppress diagnostic messages, in order not to tamper the process output. - * `tramp-direct-async-args' - An additional argument when a direct asynchronous process is - started. Used so far only in the \"mock\" method of tramp-tests.el. + * `tramp-direct-async' + Whether the method supports direct asynchronous processes. + Until now, just \"ssh\"-based and \"adb\"-based methods do. * `tramp-copy-program' 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." Message is formatted with FMT-STRING as control string and the remaining ARGUMENTS to actually emit the message (if applicable)." (let ((inhibit-message t) - file-name-handler-alist message-log-max signal-hook-function) + create-lockfiles file-name-handler-alist message-log-max + signal-hook-function) (with-current-buffer (tramp-get-debug-buffer vec) (goto-char (point-max)) (let ((point (point))) @@ -1982,6 +1983,13 @@ the resulting error message." (put #'tramp-with-demoted-errors 'tramp-suppress-trace t) +(defun tramp-test-message (fmt-string &rest arguments) + "Emit a Tramp message according `default-directory'." + (if (tramp-tramp-file-p default-directory) + (apply #'tramp-message + (tramp-dissect-file-name default-directory) 0 fmt-string arguments) + (apply #'message fmt-string arguments))) + ;; This function provides traces in case of errors not triggered by ;; Tramp functions. (defun tramp-signal-hook-function (error-symbol data) @@ -3741,7 +3749,9 @@ User is always nil." (let ((v (tramp-dissect-file-name default-directory)) (buffer (plist-get args :buffer)) (stderr (plist-get args :stderr))) - (and ;; It has been indicated. + (and ;; The method supports it. + (tramp-get-method-parameter v 'tramp-direct-async) + ;; It has been indicated. (tramp-get-connection-property v "direct-async-process" nil) ;; There's no multi-hop. (or (not (tramp-multi-hop-p v)) @@ -3821,8 +3831,6 @@ It does not support `:stderr'." (tramp-get-method-parameter v 'tramp-login-args)) (async-args (tramp-get-method-parameter v 'tramp-async-args)) - (direct-async-args - (tramp-get-method-parameter v 'tramp-direct-async-args)) ;; We don't create the temporary file. In fact, it ;; is just a prefix for the ControlPath option of ;; ssh; the real temporary file has another name, and @@ -3850,7 +3858,7 @@ It does not support `:stderr'." ?h (or host "") ?u (or user "") ?p (or port "") ?c options ?l "") ;; Add arguments for asynchronous processes. - login-args (append async-args direct-async-args login-args) + login-args (append async-args login-args) ;; Expand format spec. login-args (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 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.5.0 +;; Version: 2.5.1-pre ;; Package-Requires: ((emacs "25.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.5.0" +(defconst tramp-version "2.5.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -76,7 +76,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-lessp emacs-version "25.1")) "ok" - (format "Tramp 2.5.0 is not fit for %s" + (format "Tramp 2.5.1-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) 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." (pixel-line-height)))) (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close (scroll-up 1) ; relay on robust method - (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) - (vertical-motion 1)) ; move point downward + (catch 'no-movement + (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) + (unless (>= (vertical-motion 1) 1) ; move point downward + (throw 'no-movement nil)))) ; exit loop when point did not move (pixel-scroll-pixel-up amt)))))) ; move scope downward (defun pixel-scroll-down (&optional arg) @@ -149,8 +151,10 @@ This is and alternative of `scroll-down'. Scope moves upward." pixel-resolution-fine-flag (frame-char-height)) (pixel-line-height -1)))) - (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries) - (vertical-motion -1)) ; move point upward + (catch 'no-movement + (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries) + (unless (<= (vertical-motion -1) -1) ; move point upward + (throw 'no-movement nil)))) ; exit loop when point did not move (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen (pixel-eob-at-top-p)) ; for file with a long line (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 @@ ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> ;; Maintainer: João Távora <joaotavora@gmail.com> -;; Version: 1.1.0 +;; Version: 1.1.1 ;; Keywords: c languages tools ;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) @@ -1283,6 +1283,8 @@ correctly.") (when (flymake-running-backends) flymake-mode-line-counter-format)) (defun flymake--mode-line-counter (type &optional no-space) + "Compute number of diagnostics in buffer with TYPE's severity. +TYPE is usually keyword `:error', `:warning' or `:note'." (let ((count 0) (face (flymake--lookup-type-property type 'mode-line-face @@ -1290,7 +1292,8 @@ correctly.") (maphash (lambda (_b state) (dolist (d (flymake--backend-state-diags state)) - (when (eq type (flymake--diag-type d)) + (when (= (flymake--severity type) + (flymake--severity (flymake--diag-type d))) (cl-incf count)))) flymake--backend-state) (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]." (declare-function compilation-read-command "compile") ;;;###autoload -(defun project-compile (command &optional comint) - "Run `compile' in the project root. -Arguments the same as in `compile'." - (interactive - (list - (let ((command (eval compile-command))) - (require 'compile) - (if (or compilation-read-command current-prefix-arg) - (compilation-read-command command) - command)) - (consp current-prefix-arg))) - (let* ((pr (project-current t)) - (default-directory (project-root pr))) - (compile command comint))) +(defun project-compile () + "Run `compile' in the project root." + (interactive) + (let ((default-directory (project-root (project-current t)))) + (call-interactively #'compile))) (defun project--read-project-buffer () (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: (define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]" "Major mode for editing Mercury programs. Actually this is just customized `prolog-mode'." - (setq-local prolog-system 'mercury)) + (setq-local prolog-system 'mercury) + ;; Run once more to set up based on `prolog-system' + (prolog-mode-variables)) ;;------------------------------------------------------------------- @@ -2082,7 +2084,7 @@ Argument BOUND is a buffer position limiting searching." (delq nil (cond - ((eq major-mode 'prolog-mode) + ((derived-mode-p 'prolog-mode) (list head-predicates 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." :group 'python :safe 'stringp) -(defcustom python-shell-interpreter "python" +(defcustom python-shell-interpreter + (cond ((executable-find "python3") "python3") + ((executable-find "python") "python") + (t "python3")) "Default Python interpreter for shell." + :version "28.1" :type 'string :group 'python) 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." (interactive) (xref-goto-xref t)) +(defun xref-quit-and-pop-marker-stack () + "Quit *xref* buffer, then pop the xref marker stack." + (interactive) + (quit-window) + (xref-pop-marker-stack)) + (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -793,6 +799,7 @@ references displayed in the current *xref* buffer." (define-key map (kbd ".") #'xref-next-line) (define-key map (kbd ",") #'xref-prev-line) (define-key map (kbd "g") #'xref-revert-buffer) + (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) map)) (define-derived-mode xref--xref-buffer-mode special-mode "XREF" @@ -928,8 +935,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (or (assoc-default 'fetched-xrefs alist) (funcall fetcher))) - (xref-alist (xref--analyze xrefs))) + (xref-alist (xref--analyze xrefs)) + (dd default-directory)) (with-current-buffer (get-buffer-create xref-buffer-name) + (setq default-directory dd) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer)) @@ -992,13 +1001,15 @@ When only one definition found, jump to it right away instead." When there is more than one definition, split the selected window and show the list in a small window at the bottom. And use a local keymap that binds `RET' to `xref-quit-and-goto-xref'." - (let ((xrefs (funcall fetcher))) + (let ((xrefs (funcall fetcher)) + (dd default-directory)) (cond ((not (cdr xrefs)) (xref-pop-to-location (car xrefs) (assoc-default 'display-action alist))) (t (with-current-buffer (get-buffer-create xref-buffer-name) + (setq default-directory dd) (xref--transient-buffer-mode) (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) (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'." ;; `ding' flushes the next messages about setting goal ;; column. So here I force fetch the event(mouse-2) and ;; throw away. - (read-event) + (read--potential-mouse-event) ;; Ding BEFORE `message' is OK. (when ruler-mode-set-goal-column-ding-flag (ding)) @@ -460,7 +460,7 @@ the mouse has been clicked." (track-mouse ;; Signal the display engine to freeze the mouse pointer shape. (setq track-mouse 'dragging) - (while (mouse-movement-p (setq event (read-event))) + (while (mouse-movement-p (setq event (read--potential-mouse-event))) (setq drags (1+ drags)) (when (eq window (posn-window (event-end event))) (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." (or hfile (cond ((string-equal shell "bash") "~/.bash_history") ((string-equal shell "ksh") "~/.sh_history") + ((string-equal shell "zsh") "~/.zsh_history") (t "~/.history"))))) (if (or (equal comint-input-ring-file-name "") (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'." ;; kill-line and its subroutines. (defcustom kill-whole-line nil - "If non-nil, `kill-line' with no arg at start of line kills the whole line." + "If non-nil, `kill-line' with no arg at start of line kills the whole line. +This variable also affects `kill-visual-line' in the same way as +it does `kill-line'." :type 'boolean :group 'killing) @@ -7319,6 +7321,10 @@ If ARG is negative, kill visual lines backward. If ARG is zero, kill the text before point on the current visual line. +If the variable `kill-whole-line' is non-nil, and this command is +invoked at start of a line that ends in a newline, kill the newline +as well. + If you want to append the killed line to the last killed text, use \\[append-next-kill] before \\[kill-line]. @@ -7331,18 +7337,30 @@ even beep.)" ;; Like in `kill-line', it's better to move point to the other end ;; of the kill before killing. (let ((opoint (point)) - (kill-whole-line (and kill-whole-line (bolp)))) + (kill-whole-line (and kill-whole-line (bolp))) + (orig-y (cdr (nth 2 (posn-at-point)))) + ;; FIXME: This tolerance should be zero! It isn't due to a + ;; bug in posn-at-point, see bug#45837. + (tol (/ (line-pixel-height) 2))) (if arg (vertical-motion (prefix-numeric-value arg)) (end-of-visual-line 1) (if (= (point) opoint) (vertical-motion 1) - ;; Skip any trailing whitespace at the end of the visual line. - ;; We used to do this only if `show-trailing-whitespace' is - ;; nil, but that's wrong; the correct thing would be to check - ;; whether the trailing whitespace is highlighted. But, it's - ;; OK to just do this unconditionally. - (skip-chars-forward " \t"))) + ;; The first condition below verifies we are still on the same + ;; screen line, i.e. that the line isn't continued, and that + ;; end-of-visual-line didn't overshoot due to complications + ;; like display or overlay strings, intangible text, etc.: + ;; otherwise, we don't want to kill a character that's + ;; unrelated to the place where the visual line wrapped. + (and (< (abs (- (cdr (nth 2 (posn-at-point))) orig-y)) tol) + ;; Make sure we delete the character where the line wraps + ;; under visual-line-mode, be it whitespace or a + ;; character whose category set allows to wrap at it. + (or (looking-at-p "[ \t]") + (and word-wrap-by-category + (aref (char-category-set (following-char)) ?\|))) + (forward-char)))) (kill-region opoint (if (and kill-whole-line (= (following-char) ?\n)) (1+ (point)) (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 loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is called with no arguments and should return the name of an alternate init-file to load. If LOAD-DEFAULTS is non-nil, then -load default.el after the init-file. +load default.el after the init-file, unless `inhibit-default-init' +is non-nil. This function sets `user-init-file' to the name of the loaded init-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." (sit-for 1)) (setq user-init-file source)))) - (when load-defaults - + (when (and load-defaults + (not inhibit-default-init)) ;; Prevent default.el from changing the value of ;; `inhibit-startup-screen'. (let ((inhibit-startup-screen nil)) @@ -1174,12 +1175,11 @@ please check its value") ;; Re-evaluate predefined variables whose initial value depends on ;; the runtime context. - (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH - (setq custom-delayed-init-variables - ;; Initialize them in the same order they were loaded, in case there - ;; are dependencies between them. - (nreverse custom-delayed-init-variables)) - (mapc 'custom-reevaluate-setting custom-delayed-init-variables)) + (setq custom-delayed-init-variables + ;; Initialize them in the same order they were loaded, in case there + ;; are dependencies between them. + (nreverse custom-delayed-init-variables)) + (mapc #'custom-reevaluate-setting custom-delayed-init-variables) ;; Warn for invalid user name. (when init-file-user @@ -1296,8 +1296,7 @@ please check its value") (if (or noninteractive emacs-basic-display) (setq menu-bar-mode nil tab-bar-mode nil - tool-bar-mode nil - no-blinking-cursor t)) + tool-bar-mode nil)) (frame-initialize)) (when (fboundp 'x-create-frame) @@ -1306,15 +1305,6 @@ please check its value") (unless noninteractive (tool-bar-setup))) - ;; Turn off blinking cursor if so specified in X resources. This is here - ;; only because all other settings of no-blinking-cursor are here. - (unless (or noninteractive - emacs-basic-display - (and (memq window-system '(x w32 ns)) - (not (member (x-get-resource "cursorBlink" "CursorBlink") - '("no" "off" "false" "0"))))) - (setq no-blinking-cursor t)) - (unless noninteractive (startup--setup-quote-display) (setq internal--text-quoting-flag t)) @@ -1322,9 +1312,8 @@ please check its value") ;; Re-evaluate again the predefined variables whose initial value ;; depends on the runtime context, in case some of them depend on ;; the window-system features. Example: blink-cursor-mode. - (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH - (mapc 'custom-reevaluate-setting custom-delayed-init-variables) - (setq custom-delayed-init-variables nil)) + (mapc #'custom-reevaluate-setting custom-delayed-init-variables) + (setq custom-delayed-init-variables nil) (normal-erase-is-backspace-setup-frame) @@ -1382,7 +1371,7 @@ please check its value") (expand-file-name "init.el" startup-init-directory)) - (not inhibit-default-init)) + t) (when (and deactivate-mark transient-mark-mode) (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." (strokes-fill-current-buffer-with-whitespace)) (when prompt (message "%s" prompt) - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (or (strokes-button-press-event-p event) (error "You must draw with the mouse"))) (unwind-protect (track-mouse - (or event (setq event (read-event) + (or event (setq event (read--potential-mouse-event) safe-to-draw-p t)) (while (not (strokes-button-release-event-p event)) (if (strokes-mouse-event-p event) @@ -776,7 +776,7 @@ Optional EVENT is acceptable as the starting event of the stroke." (setq safe-to-draw-p t)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read-event))))) + (setq event (read--potential-mouse-event))))) ;; protected ;; clean up strokes buffer and then bury it. (when (equal (buffer-name) strokes-buffer-name) @@ -787,16 +787,16 @@ Optional EVENT is acceptable as the starting event of the stroke." ;; Otherwise, don't use strokes buffer and read stroke silently (when prompt (message "%s" prompt) - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (or (strokes-button-press-event-p event) (error "You must draw with the mouse"))) (track-mouse - (or event (setq event (read-event))) + (or event (setq event (read--potential-mouse-event))) (while (not (strokes-button-release-event-p event)) (if (strokes-mouse-event-p event) (push (cdr (mouse-pixel-position)) pix-locs)) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) @@ -817,10 +817,10 @@ Optional EVENT is acceptable as the starting event of the stroke." (if prompt (while (not (strokes-button-press-event-p event)) (message "%s" prompt) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) (unwind-protect (track-mouse - (or event (setq event (read-event))) + (or event (setq event (read--potential-mouse-event))) (while (not (and (strokes-button-press-event-p event) (eq 'mouse-3 (car (get (car event) @@ -834,14 +834,15 @@ Optional EVENT is acceptable as the starting event of the stroke." ?\s strokes-character)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read-event))) + (setq event (read--potential-mouse-event))) (push strokes-lift pix-locs) (while (not (strokes-button-press-event-p event)) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) ;; ### KLUDGE! ### sit and wait ;; for some useless event to ;; happen to fix the minibuffer bug. - (while (not (strokes-button-release-event-p (read-event)))) + (while (not (strokes-button-release-event-p + (read--potential-mouse-event)))) (setq pix-locs (nreverse (cdr pix-locs)) grid-locs (strokes-renormalize-to-grid pix-locs)) (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." (if (current-local-map) (local-set-key key nil)) nil) + +(defun local-key-binding (keys &optional accept-default) + "Return the binding for command KEYS in current local keymap only. +KEYS is a string or vector, a sequence of keystrokes. +The binding is probably a symbol with a function definition. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details +about this." + (let ((map (current-local-map))) + (when map (lookup-key map keys accept-default)))) + +(defun global-key-binding (keys &optional accept-default) + "Return the binding for command KEYS in current global keymap only. +KEYS is a string or vector, a sequence of keystrokes. +The binding is probably a symbol with a function definition. +This function's return values are the same as those of `lookup-key' +\(which see). + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details +about this." + (lookup-key (current-global-map) keys accept-default)) + ;;;; substitute-key-definition and its subroutines. @@ -1335,7 +1359,9 @@ The normal global definition of the character C-x indirects to this keymap.") map) "Default global keymap mapping Emacs keyboard input into commands. The value is a keymap that is usually (but not necessarily) Emacs's -global map.") +global map. + +See also `current-global-map'.") (use-global-map global-map) @@ -1879,9 +1905,33 @@ all symbols are bound before any of the VALUEFORMs are evalled." ;; As a special-form, we could implement it more efficiently (and cleanly, ;; making the vars actually unbound during evaluation of the binders). (declare (debug let) (indent 1)) - `(let ,(mapcar #'car binders) - ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) - ,@body)) + ;; Use plain `let*' for the non-recursive definitions. + ;; This only handles the case where the first few definitions are not + ;; recursive. Nothing as fancy as an SCC analysis. + (let ((seqbinds nil)) + ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep' + ;; may fail to see references that will be introduced later by + ;; macroexpansion. We could call `macroexpand-all' to avoid that, + ;; but in order to avoid that, we instead check to see if the binders + ;; appear in the macroexp environment, since that's how references can be + ;; introduced later on. + (unless (macroexp--fgrep binders macroexpand-all-environment) + (while (and binders + (null (macroexp--fgrep binders (nth 1 (car binders))))) + (push (pop binders) seqbinds))) + (let ((nbody (if (null binders) + (macroexp-progn body) + `(let ,(mapcar #'car binders) + ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) + ,@body)))) + (cond + ;; All bindings are recursive. + ((null seqbinds) nbody) + ;; Special case for trivial uses. + ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds))) + (nth 1 (car seqbinds))) + ;; General case. + (t `(let* ,(nreverse seqbinds) ,nbody)))))) (defmacro dlet (binders &rest body) "Like `let*' but using dynamic scoping." @@ -2524,23 +2574,52 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'." ;;;; Input and display facilities. -(defconst read-key-empty-map (make-sparse-keymap)) +;; The following maps are used by `read-key' to remove all key +;; bindings while calling `read-key-sequence'. This way the keys +;; returned are independent of the key binding state. + +(defconst read-key-empty-map (make-sparse-keymap) + "Used internally by `read-key'.") + +(defconst read-key-full-map + (let ((map (make-sparse-keymap))) + (define-key map [t] 'dummy) + + ;; ESC needs to be unbound so that escape sequences in + ;; `input-decode-map' are still processed by `read-key-sequence'. + (define-key map [?\e] nil) + map) + "Used internally by `read-key'.") (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. -(defun read-key (&optional prompt) +(defun read-key (&optional prompt disable-fallbacks) "Read a key from the keyboard. Contrary to `read-event' this will not return a raw event but instead will obey the input decoding and translations usually done by `read-key-sequence'. So escape sequences and keyboard encoding are taken into account. When there's an ambiguity because the key looks like the prefix of -some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." +some sort of escape sequence, the ambiguity is resolved via `read-key-delay'. + +If the optional argument PROMPT is non-nil, display that as a +prompt. + +If the optional argument DISABLE-FALLBACKS is non-nil, all +unbound fallbacks usually done by `read-key-sequence' are +disabled such as discarding mouse down events. This is generally +what you want as `read-key' temporarily removes all bindings +while calling `read-key-sequence'. If nil or unspecified, the +only unbound fallback disabled is downcasing of the last event." ;; This overriding-terminal-local-map binding also happens to ;; disable quail's input methods, so although read-key-sequence ;; always inherits the input method, in practice read-key does not ;; inherit the input method (at least not if it's based on quail). (let ((overriding-terminal-local-map nil) - (overriding-local-map read-key-empty-map) + (overriding-local-map + ;; FIXME: Audit existing uses of `read-key' to see if they + ;; should always specify disable-fallbacks to be more in line + ;; with `read-event'. + (if disable-fallbacks read-key-full-map read-key-empty-map)) (echo-keystrokes 0) (old-global-map (current-global-map)) (timer (run-with-idle-timer @@ -2594,6 +2673,23 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (message nil) (use-global-map old-global-map)))) +;; FIXME: Once there's a safe way to transition away from read-event, +;; callers to this function should be updated to that way and this +;; function should be deleted. +(defun read--potential-mouse-event () + "Read an event that might be a mouse event. + +This function exists for backward compatibility in code packaged +with Emacs. Do not call it directly in your own packages." + ;; `xterm-mouse-mode' events must go through `read-key' as they + ;; are decoded via `input-decode-map'. + (if xterm-mouse-mode + (read-key nil + ;; Normally `read-key' discards all mouse button + ;; down events. However, we want them here. + t) + (read-event))) + (defvar read-passwd-map ;; BEWARE: `defconst' would purecopy it, breaking the sharing with ;; 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." (setq timer (run-at-time interval interval draw-fn x1 y1)))) ;; Read next event - (setq ev (read-event)))) + (setq ev (read--potential-mouse-event)))) ;; Cleanup: get rid of any active timer. (if timer (cancel-timer timer))) @@ -5212,7 +5212,7 @@ The event, EV, is the mouse event." ;; Read next event (only if we should not stop) (if (not done) - (setq ev (read-event))))) + (setq ev (read--potential-mouse-event))))) ;; Reverse point-list (last points are cond'ed first) (setq point-list (reverse point-list)) @@ -5339,7 +5339,7 @@ The event, EV, is the mouse event." ;; Read next event - (setq ev (read-event)))) + (setq ev (read--potential-mouse-event)))) ;; If we are not rubber-banding (that is, we were moving around the `2') ;; 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." ;; This is the actual filling loop. (goto-char from) - (let (linebeg) + (let ((first t) + linebeg) (while (< (point) to) - (setq linebeg (point)) + ;; On the first line, there may be text in the fill prefix + ;; zone. In that case, don't consider that area when + ;; trying to find a place to put a line break (bug#45720). + (if (not first) + (setq linebeg (point)) + (setq first nil + linebeg (+ (point) (length fill-prefix)))) (move-to-column (current-fill-column)) (if (when (< (point) to) ;; 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." ,(concat ;; Make sure we search only for optional arguments of ;; environments/macros and don't match any other [. ctable - ;; provides a macro called \ctable, listings/breqn have + ;; provides a macro called \ctable, beamer/breqn/listings have ;; environments. Start with a backslash and a group for names "\\\\\\(?:" ;; begin, optional spaces and opening brace "begin[[:space:]]*{" ;; Build a regexp for env names - (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray")) + (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" + "darray" "frame")) ;; closing brace, optional spaces "}[[:space:]]*" ;; Now for macros @@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them." "\\[[^][]*" ;; Allow nested levels of chars enclosed in braces "\\(?:{[^}{]*" - "\\(?:{[^}{]*" - "\\(?:{[^}{]*}[^}{]*\\)*" - "}[^}{]*\\)*" + "\\(?:{[^}{]*" + "\\(?:{[^}{]*}[^}{]*\\)*" + "}[^}{]*\\)*" "}[^][]*\\)*" ;; Match the label key "\\<label[[:space:]]*=[[:space:]]*" @@ -935,8 +936,9 @@ The default value matches usual \\label{...} definitions and keyval style [..., label = {...}, ...] label definitions. The regexp for keyval style explicitly looks for environments provided by the packages \"listings\" (\"lstlisting\"), -\"breqn\" (\"dmath\", \"dseries\", \"dgroup\", \"darray\") and -the macro \"\\ctable\" provided by the package of the same name. +\"beamer\" (\"frame\"), \"breqn\" (\"dmath\", \"dseries\", +\"dgroup\", \"darray\") and the macro \"\\ctable\" provided by +the package of the same name. It is assumed that the regexp group 1 matches the label text, so you 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. When changed from Lisp, make sure to call `reftex-compile-variables' afterwards to make the change effective." - :version "27.1" + :version "28.1" :set (lambda (symbol value) (set symbol value) (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." (let (event) (message "Select windows by clicking. Please click on Window %d " wind-number) - (while (not (ediff-mouse-event-p (setq event (read-event)))) + (while (not (ediff-mouse-event-p (setq event + (read--potential-mouse-event)))) (if (sit-for 1) ; if sequence of events, wait till the final word (beep 1)) (message "Please click on Window %d " wind-number)) - (read-event) ; discard event + (read--potential-mouse-event) ; discard event (posn-window (event-start event)))) 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." ;; If WIND-A is nil, use selected window. ;; If WIND-B is nil, use window next to WIND-A. (defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode) - (if (or dumb-mode (not (ediff-window-display-p))) + (if (or dumb-mode (not (display-mouse-p))) (setq wind-A (ediff-get-next-window wind-A nil) wind-B (ediff-get-next-window wind-B wind-A)) (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." (unless (widget-apply button :mouse-down-action event) (let ((track-mouse t)) (while (not (widget-button-release-event-p event)) - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (when (and mouse-1 (mouse-movement-p event)) (push event unread-command-events) (setq event oevent) @@ -1169,7 +1169,7 @@ If nothing was called, return non-nil." (when up ;; Don't execute up events twice. (while (not (widget-button-release-event-p event)) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) (when command (call-interactively command))))) (message "You clicked somewhere weird."))) @@ -3486,14 +3486,16 @@ It reads a directory name from an editable text field." :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value" :tag "Key sequence") +;; FIXME: Consider combining this with help--read-key-sequence which +;; can also read double and triple mouse events. (defun widget-key-sequence-read-event (ev) (interactive (list (let ((inhibit-quit t) quit-flag) - (read-event "Insert KEY, EVENT, or CODE: ")))) + (read-key "Insert KEY, EVENT, or CODE: " t)))) (let ((ev2 (and (memq 'down (event-modifiers ev)) - (read-event))) - (tr (and (keymapp function-key-map) - (lookup-key function-key-map (vector ev))))) + (read-key nil t))) + (tr (and (keymapp local-function-key-map) + (lookup-key local-function-key-map (vector ev))))) (when (and (integerp ev) (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix)))) (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." (setq window (window-normalize-window window)) (cond ((< delta 0) - (max (- (window-min-size window horizontal ignore pixelwise) - (window-size window horizontal pixelwise)) - delta)) + (let ((min-size (window-min-size window horizontal ignore pixelwise)) + (size (window-size window horizontal pixelwise))) + (if (<= size min-size) + 0 + (max (- min-size size) delta)))) ((> delta 0) (if (window-size-fixed-p window horizontal ignore) 0 @@ -4116,7 +4118,10 @@ frame can be safely deleted." frame)) (throw 'other t)))) (let ((minibuf (active-minibuffer-window))) - (and minibuf (eq frame (window-frame minibuf))))) + (and minibuf (eq frame (window-frame minibuf)) + (not (eq (default-toplevel-value + minibuffer-follows-selected-frame) + t))))) 'frame)) ((window-minibuffer-p window) ;; If WINDOW is the minibuffer window of a non-minibuffer-only |