(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.
(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)))
(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))))
;; 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.
(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
(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))
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))
;; 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.
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))
;; 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.
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.
(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;
(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)
;; 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)
doc string for `insert-for-yank-1', which see."
(interactive "*p")
(if (not (eq last-command 'yank))
- (error "Previous command was not a yank"))
+ (user-error "Previous command was not a yank"))
(setq this-command 'yank)
(unless arg (setq arg 1))
(let ((inhibit-read-only t)
;; 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).
(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.
(or use-empty-active-region (> (region-end) (region-beginning)))))
(defun region-active-p ()
- "Return t if Transient Mark mode is enabled and the mark is active.
+ "Return non-nil if Transient Mark mode is enabled and the mark is active.
Some commands act specially on the region when Transient Mark
mode is enabled. Usually, such commands should use
;; 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
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
\(Does not affect global mark ring)."
(interactive)
(if (null (mark t))
- (error "No mark set in this buffer")
+ (user-error "No mark set in this buffer")
(if (= (point) (mark t))
(message "Mark popped"))
(goto-char (mark t))
(let ((omark (mark t))
(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
(if (null omark)
- (error "No mark set in this buffer"))
+ (user-error "No mark set in this buffer"))
(set-mark (point))
(goto-char omark)
(cond (temp-highlight
Transient Mark mode if ARG is omitted or nil.
Transient Mark mode is a global minor mode. When enabled, the
-region is highlighted whenever the mark is active. The mark is
-\"deactivated\" by changing the buffer, and after certain other
-operations that set the mark but whose main purpose is something
-else--for example, incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
+region is highlighted with the `region' face whenever the mark
+is active. The mark is \"deactivated\" by changing the buffer,
+and after certain other operations that set the mark but whose
+main purpose is something else--for example, incremental search,
+\\[beginning-of-buffer], and \\[end-of-buffer].
You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].
(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)
(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.
;; 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))))))))
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."
(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.
(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)
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))
(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))
(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"))))))
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.")