X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/36a50f38fbbcf5cc0cafc44af9d1bfcd6c13fc25..5091586f5704280e04dc3d12354965d24693f0d5:/lisp/simple.el?ds=inline diff --git a/lisp/simple.el b/lisp/simple.el index 1e64f998fd..2636777bb9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -693,7 +693,8 @@ any other non-digit terminates the character code and is then used as input.")) (cond ((null translated)) ((not (integerp translated)) (setq unread-command-events - (listify-key-sequence (this-single-command-raw-keys)) + (nconc (listify-key-sequence (this-single-command-raw-keys)) + unread-command-events) done t)) ((/= (logand translated ?\M-\^@) 0) ;; Turn a meta-character into a character with the 0200 bit set. @@ -713,7 +714,8 @@ any other non-digit terminates the character code and is then used as input.")) (setq done t)) ((not first) (setq unread-command-events - (listify-key-sequence (this-single-command-raw-keys)) + (nconc (listify-key-sequence (this-single-command-raw-keys)) + unread-command-events) done t)) (t (setq code translated done t))) @@ -1255,10 +1257,7 @@ in *Help* buffer. See also the command `describe-char'." (end (point-max)) (pos (point)) (total (buffer-size)) - (percent (if (> total 50000) - ;; Avoid overflow from multiplying by 100! - (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1)) - (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1)))) + (percent (round (* 100.0 (1- pos)) (max 1 total))) (hscroll (if (= (window-hscroll) 0) "" (format " Hscroll=%d" (window-hscroll)))) @@ -1448,7 +1447,7 @@ this command arranges for all errors to enter the debugger." ;; Bind debug-on-error to something unique so that we can ;; detect when evalled code changes it. (let ((debug-on-error old-value)) - (push (eval exp lexical-binding) values) + (push (eval (macroexpand-all exp) lexical-binding) values) (setq new-value debug-on-error)) ;; If evalled code has changed the value of debug-on-error, ;; propagate that change to the global binding. @@ -1776,6 +1775,7 @@ in this use of the minibuffer.") (defun minibuffer-avoid-prompt (_new _old) "A point-motion hook for the minibuffer, that moves point out of the prompt." + (declare (obsolete cursor-intangible-mode "25.1")) (constrain-to-field nil (point-max))) (defcustom minibuffer-history-case-insensitive-variables nil @@ -1940,7 +1940,9 @@ The argument NABS specifies the absolute history position." (user-error (if minibuffer-default "End of defaults; no next item" "End of history; no default available"))) - (if (> nabs (length (symbol-value minibuffer-history-variable))) + (if (> nabs (if (listp (symbol-value minibuffer-history-variable)) + (length (symbol-value minibuffer-history-variable)) + 0)) (user-error "Beginning of history; no preceding item")) (unless (memq last-command '(next-history-element previous-history-element)) @@ -1990,7 +1992,14 @@ When point moves over the bottom line of multi-line minibuffer, puts ARGth next element of the minibuffer history in the minibuffer." (interactive "^p") (or arg (setq arg 1)) - (let ((old-point (point))) + (let* ((old-point (point)) + ;; Remember the original goal column of possibly multi-line input + ;; excluding the length of the prompt on the first line. + (prompt-end (minibuffer-prompt-end)) + (old-column (unless (and (eolp) (> (point) prompt-end)) + (if (= (line-number-at-pos) 1) + (max (- (current-column) (1- prompt-end)) 0) + (current-column))))) (condition-case nil (with-no-warnings (next-line arg)) @@ -1998,7 +2007,14 @@ next element of the minibuffer history in the minibuffer." ;; Restore old position since `line-move-visual' moves point to ;; the end of the line when it fails to go to the next line. (goto-char old-point) - (next-history-element arg))))) + (next-history-element arg) + ;; Restore the original goal column on the last line + ;; of possibly multi-line input. + (goto-char (point-max)) + (when old-column + (if (= (line-number-at-pos) 1) + (move-to-column (+ old-column (1- (minibuffer-prompt-end)))) + (move-to-column old-column))))))) (defun previous-line-or-history-element (&optional arg) "Move cursor vertically up ARG lines, or to the previous history element. @@ -2006,7 +2022,14 @@ When point moves over the top line of multi-line minibuffer, puts ARGth previous element of the minibuffer history in the minibuffer." (interactive "^p") (or arg (setq arg 1)) - (let ((old-point (point))) + (let* ((old-point (point)) + ;; Remember the original goal column of possibly multi-line input + ;; excluding the length of the prompt on the first line. + (prompt-end (minibuffer-prompt-end)) + (old-column (unless (and (eolp) (> (point) prompt-end)) + (if (= (line-number-at-pos) 1) + (max (- (current-column) (1- prompt-end)) 0) + (current-column))))) (condition-case nil (with-no-warnings (previous-line arg)) @@ -2014,7 +2037,15 @@ previous element of the minibuffer history in the minibuffer." ;; Restore old position since `line-move-visual' moves point to ;; the beginning of the line when it fails to go to the previous line. (goto-char old-point) - (previous-history-element arg))))) + (previous-history-element arg) + ;; Restore the original goal column on the first line + ;; of possibly multi-line input. + (goto-char (minibuffer-prompt-end)) + (if old-column + (if (= (line-number-at-pos) 1) + (move-to-column (+ old-column (1- (minibuffer-prompt-end)))) + (move-to-column old-column)) + (goto-char (line-end-position))))))) (defun next-complete-history-element (n) "Get next history element which completes the minibuffer before the point. @@ -3286,7 +3317,7 @@ display the error buffer if there were any errors. When called interactively, this is t." (interactive (let (string) (unless (mark) - (error "The mark is not set now, so there is no region")) + (user-error "The mark is not set now, so there is no region")) ;; Do this before calling region-beginning ;; and region-end, in case subprocess output ;; relocates them while we are in the minibuffer. @@ -3456,9 +3487,9 @@ value passed." (defvar process-file-side-effects t "Whether a call of `process-file' changes remote files. -By default, this variable is always set to `t', meaning that a +By default, this variable is always set to t, meaning that a call of `process-file' could potentially change any file on a -remote host. When set to `nil', a file handler could optimize +remote host. When set to nil, a file handler could optimize its behavior with respect to remote file attribute caching. You should only ever change this variable with a let-binding; @@ -3489,7 +3520,7 @@ support pty association, if PROGRAM is nil." (defvar tabulated-list-sort-key) (declare-function tabulated-list-init-header "tabulated-list" ()) (declare-function tabulated-list-print "tabulated-list" - (&optional remember-pos)) + (&optional remember-pos update)) (defvar process-menu-query-only nil) @@ -3985,7 +4016,7 @@ some text between BEG and END, but we're killing the region." ;; calling `kill-append'. (interactive (list (mark) (point) 'region)) (unless (and beg end) - (error "The mark is not set now, so there is no region")) + (user-error "The mark is not set now, so there is no region")) (condition-case nil (let ((string (if region (funcall region-extract-function 'delete) @@ -4776,13 +4807,14 @@ run `deactivate-mark-hook'." ;; the region prior to the last command modifying the buffer. ;; Set the selection to that, or to the current region. (cond (saved-region-selection - (gui-set-selection 'PRIMARY saved-region-selection) + (if (gui-backend-selection-owner-p 'PRIMARY) + (gui-set-selection 'PRIMARY saved-region-selection)) (setq saved-region-selection nil)) ;; If another program has acquired the selection, region ;; deactivation should not clobber it (Bug#11772). ((and (/= (region-beginning) (region-end)) - (or (gui-call gui-selection-owner-p 'PRIMARY) - (null (gui-call gui-selection-exists-p 'PRIMARY)))) + (or (gui-backend-selection-owner-p 'PRIMARY) + (null (gui-backend-selection-exists-p 'PRIMARY)))) (gui-set-selection 'PRIMARY (funcall region-extract-function nil))))) (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382). @@ -4837,6 +4869,45 @@ store it in a Lisp variable. Example: (setq mark-active nil) (set-marker (mark-marker) nil))) +(defun save-mark-and-excursion--save () + (cons + (let ((mark (mark-marker))) + (and (marker-position mark) (copy-marker mark))) + mark-active)) + +(defun save-mark-and-excursion--restore (saved-mark-info) + (let ((saved-mark (car saved-mark-info)) + (omark (marker-position (mark-marker))) + (nmark nil) + (saved-mark-active (cdr saved-mark-info))) + ;; Mark marker + (if (null saved-mark) + (set-marker (mark-marker) nil) + (setf nmark (marker-position saved-mark)) + (set-marker (mark-marker) nmark) + (set-marker saved-mark nil)) + ;; Mark active + (let ((cur-mark-active mark-active)) + (setq mark-active saved-mark-active) + ;; If mark is active now, and either was not active or was at a + ;; different place, run the activate hook. + (if saved-mark-active + (when (or (not cur-mark-active) + (not (eq omark nmark))) + (run-hooks 'activate-mark-hook)) + ;; If mark has ceased to be active, run deactivate hook. + (when cur-mark-active + (run-hooks 'deactivate-mark-hook)))))) + +(defmacro save-mark-and-excursion (&rest body) + "Like `save-excursion', but also save and restore the mark state. +This macro does what `save-excursion' did before Emacs 25.1." + (let ((saved-marker-sym (make-symbol "saved-marker"))) + `(let ((,saved-marker-sym (save-mark-and-excursion--save))) + (unwind-protect + (save-excursion ,@body) + (save-mark-and-excursion--restore ,saved-marker-sym))))) + (defcustom use-empty-active-region nil "Whether \"region-aware\" commands should act on empty regions. If nil, region-aware commands treat empty regions as inactive. @@ -4876,7 +4947,7 @@ also checks the value of `use-empty-active-region'." ;; without the mark being set (e.g. bug#17324). We really should fix ;; that problem, but in the mean time, let's make sure we don't say the ;; region is active when there's no mark. - (mark))) + (progn (cl-assert (mark)) t))) (defvar redisplay-unhighlight-region-function @@ -4902,37 +4973,41 @@ also checks the value of `use-empty-active-region'." rol))) (defun redisplay--update-region-highlight (window) - (with-current-buffer (window-buffer window) - (let ((rol (window-parameter window 'internal-region-overlay))) - (if (not (region-active-p)) - (funcall redisplay-unhighlight-region-function rol) - (let* ((pt (window-point window)) - (mark (mark)) - (start (min pt mark)) - (end (max pt mark)) - (new - (funcall redisplay-highlight-region-function - start end window rol))) - (unless (equal new rol) - (set-window-parameter window 'internal-region-overlay - new))))))) - -(defun redisplay--update-region-highlights (windows) - (with-demoted-errors "redisplay--update-region-highlights: %S" + (let ((rol (window-parameter window 'internal-region-overlay))) + (if (not (and (region-active-p) + (or highlight-nonselected-windows + (eq window (selected-window)) + (and (window-minibuffer-p) + (eq window (minibuffer-selected-window)))))) + (funcall redisplay-unhighlight-region-function rol) + (let* ((pt (window-point window)) + (mark (mark)) + (start (min pt mark)) + (end (max pt mark)) + (new + (funcall redisplay-highlight-region-function + start end window rol))) + (unless (equal new rol) + (set-window-parameter window 'internal-region-overlay + new)))))) + +(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight) + "Hook run just before redisplay. +It is called in each window that is to be redisplayed. It takes one argument, +which is the window that will be redisplayed. When run, the `current-buffer' +is set to the buffer displayed in that window.") + +(defun redisplay--pre-redisplay-functions (windows) + (with-demoted-errors "redisplay--pre-redisplay-functions: %S" (if (null windows) - (redisplay--update-region-highlight (selected-window)) - (unless (listp windows) (setq windows (window-list-1 nil nil t))) - (if highlight-nonselected-windows - (mapc #'redisplay--update-region-highlight windows) - (let ((msw (and (window-minibuffer-p) (minibuffer-selected-window)))) - (dolist (w windows) - (if (or (eq w (selected-window)) (eq w msw)) - (redisplay--update-region-highlight w) - (funcall redisplay-unhighlight-region-function - (window-parameter w 'internal-region-overlay))))))))) + (with-current-buffer (window-buffer (selected-window)) + (run-hook-with-args 'pre-redisplay-functions (selected-window))) + (dolist (win (if (listp windows) windows (window-list-1 nil nil t))) + (with-current-buffer (window-buffer win) + (run-hook-with-args 'pre-redisplay-functions win)))))) (add-function :before pre-redisplay-function - #'redisplay--update-region-highlights) + #'redisplay--pre-redisplay-functions) (defvar-local mark-ring nil @@ -5378,7 +5453,10 @@ lines." (declare-function font-info "font.c" (name &optional frame)) (defun default-font-height () - "Return the height in pixels of the current buffer's default face font." + "Return the height in pixels of the current buffer's default face font. + +If the default font is remapped (see `face-remapping-alist'), the +function returns the height of the remapped face." (let ((default-font (face-font 'default))) (cond ((and (display-multi-font-p) @@ -5389,6 +5467,25 @@ lines." (aref (font-info default-font) 3)) (t (frame-char-height))))) +(defun default-font-width () + "Return the width in pixels of the current buffer's default face font. + +If the default font is remapped (see `face-remapping-alist'), the +function returns the width of the remapped face." + (let ((default-font (face-font 'default))) + (cond + ((and (display-multi-font-p) + ;; Avoid calling font-info if the frame's default font was + ;; not changed since the frame was created. That's because + ;; font-info is expensive for some fonts, see bug #14838. + (not (string= (frame-parameter nil 'font) default-font))) + (let* ((info (font-info (face-font 'default))) + (width (aref info 11))) + (if (> width 0) + width + (aref info 10)))) + (t (frame-char-width))))) + (defun default-line-height () "Return the pixel height of current buffer's default-face text line. @@ -5902,7 +5999,11 @@ and `current-column' to be able to ignore invisible text." ;; that will get us to the same place on the screen ;; but with a more reasonable buffer position. (goto-char normal-location) - (let ((line-beg (line-beginning-position))) + (let ((line-beg + ;; We want the real line beginning, so it's consistent + ;; with bolp below, otherwise we might infloop. + (let ((inhibit-field-text-motion t)) + (line-beginning-position)))) (while (and (not (bolp)) (invisible-p (1- (point)))) (goto-char (previous-char-property-change (point) line-beg)))))))) @@ -6573,7 +6674,7 @@ beyond `current-fill-column' automatically breaks the line at a previous space. When `auto-fill-mode' is on, the `auto-fill-function' variable is -non-`nil'. +non-nil. The value of `normal-auto-fill-function' specifies the function to use for `auto-fill-function' when turning Auto Fill mode on." @@ -6933,8 +7034,9 @@ The function should return non-nil if the two tokens do not match.") (buffer-substring blinkpos (1+ blinkpos)))) ;; There is nothing to show except the char itself. (t (buffer-substring blinkpos (1+ blinkpos)))))) - (message "Matches %s" - (substring-no-properties open-paren-line-string))))))))) + (minibuffer-message + "Matches %s" + (substring-no-properties open-paren-line-string))))))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. @@ -6947,6 +7049,8 @@ More precisely, a char with closeparen syntax is self-inserted.") (not executing-kbd-macro) (not noninteractive) ;; Verify an even number of quoting characters precede the close. + ;; FIXME: Also check if this parenthesis closes a comment as + ;; can happen in Pascal and SML. (= 1 (logand 1 (- (point) (save-excursion (forward-char -1) @@ -7209,6 +7313,11 @@ it were the arg to `interactive' (which see) to interactively read VALUE. If VARIABLE has been defined with `defcustom', then the type information in the definition is used to check that VALUE is valid. +Note that this function is at heart equivalent to the basic `set' function. +For a variable defined with `defcustom', it does not pay attention to +any :set property that the variable might have (if you want that, use +\\[customize-set-variable] instead). + With a prefix argument, set VARIABLE to VALUE buffer-locally." (interactive (let* ((default-var (variable-at-point)) @@ -7253,8 +7362,8 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (require 'cus-edit) (setq type (widget-convert type)) (unless (widget-apply type :match value) - (error "Value `%S' does not match type %S of %S" - value (car type) variable)))) + (user-error "Value `%S' does not match type %S of %S" + value (car type) variable)))) (if make-local (make-local-variable variable)) @@ -7577,8 +7686,7 @@ Called from `temp-buffer-show-hook'." (when completion-show-help (goto-char (point-min)) (if (display-mouse-p) - (insert (substitute-command-keys - "Click on a completion to select it.\n"))) + (insert "Click on a completion to select it.\n")) (insert (substitute-command-keys "In this buffer, type \\[choose-completion] to \ select the completion near point.\n\n")))))) @@ -8127,7 +8235,7 @@ version and use the one distributed with Emacs.")) Each element has the form (PACKAGE SYMBOL REGEXP STRING). PACKAGE is either a regular expression to match file names, or a symbol (a feature name), like for `with-eval-after-load'. -SYMBOL is either the name of a string variable, or `t'. Upon +SYMBOL is either the name of a string variable, or t. Upon loading PACKAGE, if SYMBOL is t or matches REGEXP, display a warning using STRING as the message.")