;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2015 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
;; Making and deleting lines.
+(defvar self-insert-uses-region-functions nil
+ "Special hook to tell if `self-insert-command' will use the region.
+It must be called via `run-hook-with-args-until-success' with no arguments.
+Any `post-self-insert-command' which consumes the region should
+register a function on this hook so that things like `delete-selection-mode'
+can refrain from consuming the region.")
+
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
+ (cl-assert (eq ?\n (char-before)))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (if (not interactive)
+ (unwind-protect
+ (if (not interactive)
;; FIXME: For non-interactive uses, many calls actually just want
;; (insert "\n"), so maybe we should do just that, so as to avoid
;; the risk of filling or running abbrevs unexpectedly.
(self-insert-command (prefix-numeric-value arg)))
(unwind-protect
(progn
- (add-hook 'post-self-insert-hook postproc)
+ (add-hook 'post-self-insert-hook postproc nil t)
(self-insert-command (prefix-numeric-value arg)))
;; We first used let-binding to protect the hook, but that was naive
;; since add-hook affects the symbol-default value of the variable,
;; whereas the let-binding might only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc))))
+ (remove-hook 'post-self-insert-hook postproc t)))
+ (cl-assert (not (member postproc post-self-insert-hook)))
+ (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
nil)
(defun set-hard-newline-properties (from to)
(interactive "P")
(let* ((char (following-char))
(bidi-fixer
- (cond ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e))
- ;; If the character is one of LRE, LRO, RLE, RLO, it
- ;; will start a directional embedding, which could
- ;; completely disrupt the rest of the line (e.g., RLO
- ;; will display the rest of the line right-to-left).
- ;; So we put an invisible PDF character after these
- ;; characters, to end the embedding, which eliminates
- ;; any effects on the rest of the line.
+ ;; If the character is one of LRE, LRO, RLE, RLO, it will
+ ;; start a directional embedding, which could completely
+ ;; disrupt the rest of the line (e.g., RLO will display the
+ ;; rest of the line right-to-left). So we put an invisible
+ ;; PDF character after these characters, to end the
+ ;; embedding, which eliminates any effects on the rest of
+ ;; the line. For RLE and RLO we also append an invisible
+ ;; LRM, to avoid reordering the following numerical
+ ;; characters. For LRI/RLI/FSI we append a PDI.
+ (cond ((memq char '(?\x202a ?\x202d))
(propertize (string ?\x202c) 'invisible t))
+ ((memq char '(?\x202b ?\x202e))
+ (propertize (string ?\x202c ?\x200e) 'invisible t))
+ ((memq char '(?\x2066 ?\x2067 ?\x2068))
+ (propertize (string ?\x2069) 'invisible t))
;; Strong right-to-left characters cause reordering of
;; the following numerical characters which show the
;; codepoint, so append LRM to countermand that.
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
+ ;; FIXME: call emacs-lisp-mode?
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function)
(add-hook 'completion-at-point-functions
- #'lisp-completion-at-point nil t)
+ #'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook))
(read-from-minibuffer prompt initial-contents
read-expression-map t
;; 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.
(defvar extended-command-history nil)
+(defvar execute-extended-command--last-typed nil)
(defun read-extended-command ()
"Read command name to invoke in `execute-extended-command'."
(minibuffer-with-setup-hook
(lambda ()
+ (add-hook 'post-self-insert-hook
+ (lambda ()
+ (setq execute-extended-command--last-typed
+ (minibuffer-contents)))
+ nil 'local)
(set (make-local-variable 'minibuffer-default-add-function)
(lambda ()
;; Get a command name at point in the original buffer
;; because "M-x" is a well-known prompt to read a command
;; and it serves as a shorthand for "Extended command: ".
"M-x ")
- obarray 'commandp t nil 'extended-command-history)))
+ (lambda (string pred action)
+ (let ((pred
+ (if (memq action '(nil t))
+ ;; Exclude obsolete commands from completions.
+ (lambda (sym)
+ (and (funcall pred sym)
+ (or (equal string (symbol-name sym))
+ (not (get sym 'byte-obsolete-info)))))
+ pred)))
+ (complete-with-action action obarray string pred)))
+ #'commandp t nil 'extended-command-history)))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
(integer :tag "time" 2)
(other :tag "on")))
-(defun execute-extended-command (prefixarg &optional command-name)
+(defun execute-extended-command--shorter-1 (name length)
+ (cond
+ ((zerop length) (list ""))
+ ((equal name "") nil)
+ (t
+ (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
+ (execute-extended-command--shorter-1
+ (substring name 1) (1- length)))
+ (when (string-match "\\`\\(-\\)?[^-]*" name)
+ (execute-extended-command--shorter-1
+ (substring name (match-end 0)) length))))))
+
+(defun execute-extended-command--shorter (name typed)
+ (let ((candidates '())
+ (max (length typed))
+ (len 1)
+ binding)
+ (while (and (not binding)
+ (progn
+ (unless candidates
+ (setq len (1+ len))
+ (setq candidates (execute-extended-command--shorter-1
+ name len)))
+ ;; Don't show the help message if the binding isn't
+ ;; significantly shorter than the M-x command the user typed.
+ (< len (- max 5))))
+ (let ((candidate (pop candidates)))
+ (when (equal name
+ (car-safe (completion-try-completion
+ candidate obarray 'commandp len)))
+ (setq binding candidate))))
+ binding))
+
+(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
"Read a command name, then read the arguments and call the command.
-Interactively, to pass a prefix argument to the command you are
-invoking, give a prefix argument to `execute-extended-command'.
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke."
- (interactive (list current-prefix-arg (read-extended-command)))
+To pass a prefix argument to the command you are
+invoking, give a prefix argument to `execute-extended-command'."
+ (declare (interactive-only command-execute))
+ ;; FIXME: Remember the actual text typed by the user before completion,
+ ;; so that we don't later on suggest the same shortening.
+ (interactive
+ (let ((execute-extended-command--last-typed nil))
+ (list current-prefix-arg
+ (read-extended-command)
+ execute-extended-command--last-typed)))
;; Emacs<24 calling-convention was with a single `prefixarg' argument.
- (if (null command-name)
- (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
- (read-extended-command))))
+ (unless command-name
+ (let ((current-prefix-arg prefixarg) ; for prompt
+ (execute-extended-command--last-typed nil))
+ (setq command-name (read-extended-command))
+ (setq typed execute-extended-command--last-typed)))
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
(not executing-kbd-macro)
(let ((prefix-arg prefixarg))
(command-execute function 'record))
;; If enabled, show which key runs this command.
- (when binding
- ;; But first wait, and skip the message if there is input.
- (let* ((waited
- ;; If this command displayed something in the echo area;
- ;; wait a few seconds, then display our suggestion message.
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ ;; FIXME: Wait *after* running post-command-hook!
+ ;; FIXME: Don't wait if execute-extended-command--shorter won't
+ ;; find a better answer anyway!
+ (when suggest-key-bindings
(sit-for (cond
((zerop (length (current-message))) 0)
((numberp suggest-key-bindings) suggest-key-bindings)
- (t 2)))))
- (when (and waited (not (consp unread-command-events)))
+ (t 2))))))
+ (when (and waited (not (consp unread-command-events)))
+ (unless (or binding executing-kbd-macro (not (symbolp function))
+ (<= (length (symbol-name function)) 2))
+ ;; There's no binding for CMD. Let's try and find the shortest
+ ;; string to use in M-x.
+ ;; FIXME: Can be slow. Cache it maybe?
+ (while-no-input
+ (setq binding (execute-extended-command--shorter
+ (symbol-name function) typed))))
+ (when binding
(with-temp-message
(format "You can run the command `%s' with %s"
- function (key-description binding))
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))
(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))
(or (zerop n)
(goto-history-element (+ minibuffer-history-position n))))
+(defun next-line-or-history-element (&optional arg)
+ "Move cursor vertically down ARG lines, or to the next history element.
+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))
+ ;; 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))
+ (end-of-buffer
+ ;; 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)
+ ;; 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.
+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))
+ ;; 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))
+ (beginning-of-buffer
+ ;; 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)
+ ;; 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.
The contents of the minibuffer after the point are deleted, and replaced
"Test whether UNDO-ELT crosses one edge of that region START ... END.
This assumes we have already decided that UNDO-ELT
is not *inside* the region START...END."
+ (declare (obsolete nil "25.1"))
(cond ((atom undo-elt) nil)
((null (car undo-elt))
;; (nil PROPERTY VALUE BEG . END)
;; (BEGIN . END)
(and (< (car undo-elt) end)
(> (cdr undo-elt) start)))))
-(make-obsolete 'undo-elt-crosses-region nil "24.5")
(defun undo-adjust-elt (elt deltas)
"Return adjustment of undo element ELT by the undo DELTAS
t))
\f
(defcustom password-word-equivalents
- '("password" "passphrase" "pass phrase"
+ '("password" "passcode" "passphrase" "pass phrase"
; These are sorted according to the GNU en_US locale.
"암호" ; ko
"パスワード" ; ja
;; If will create a new buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
(setq buffer (generate-new-buffer
- (or output-buffer "*Async Shell Command*")))
+ (or (and (bufferp output-buffer) (buffer-name output-buffer))
+ output-buffer "*Async Shell Command*")))
(error "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
(setq buffer (generate-new-buffer
- (or output-buffer "*Async Shell Command*"))))
+ (or (and (bufferp output-buffer) (buffer-name output-buffer))
+ output-buffer "*Async Shell Command*"))))
((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
(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;
;;;; Window system cut and paste hooks.
-(defvar interprogram-cut-function nil
+(defvar interprogram-cut-function #'gui-select-text
"Function to call to make a killed region available to other programs.
Most window systems provide a facility for cutting and pasting
text between different programs, such as the clipboard on X and
programs. The function takes one argument, TEXT, which is a
string containing the text which should be made available.")
-(defvar interprogram-paste-function nil
+(defvar interprogram-paste-function #'gui-selection-value
"Function to call to get text cut from other programs.
Most window systems provide a facility for cutting and pasting
text between different programs, such as the clipboard on X and
"Whether appending to kill ring also makes \\[undo] restore both pieces of text simultaneously."
:type 'boolean
:group 'killing
- :version "24.5")
+ :version "25.1")
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
;; 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)
(goto-char point)
;; If user quit, deactivate the mark
;; as C-g would as a command.
- (and quit-flag mark-active
+ (and quit-flag (region-active-p)
(deactivate-mark)))
(let ((len (min (abs (- mark point))
(or message-len 40))))
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
+
+(defvar bidi-directional-controls-chars "\x202a-\x202e\x2066-\x2069"
+ "Character set that matches bidirectional formatting control characters.")
+
+(defvar bidi-directional-non-controls-chars "^\x202a-\x202e\x2066-\x2069"
+ "Character set that matches any character except bidirectional controls.")
+
+(defun squeeze-bidi-context-1 (from to category replacement)
+ "A subroutine of `squeeze-bidi-context'.
+FROM and TO should be markers, CATEGORY and REPLACEMENT should be strings."
+ (let ((pt (copy-marker from))
+ (limit (copy-marker to))
+ (old-pt 0)
+ lim1)
+ (setq lim1 limit)
+ (goto-char pt)
+ (while (< pt limit)
+ (if (> pt old-pt)
+ (move-marker lim1
+ (save-excursion
+ ;; L and R categories include embedding and
+ ;; override controls, but we don't want to
+ ;; replace them, because that might change
+ ;; the visual order. Likewise with PDF and
+ ;; isolate controls.
+ (+ pt (skip-chars-forward
+ bidi-directional-non-controls-chars
+ limit)))))
+ ;; Replace any run of non-RTL characters by a single LRM.
+ (if (null (re-search-forward category lim1 t))
+ ;; No more characters of CATEGORY, we are done.
+ (setq pt limit)
+ (replace-match replacement nil t)
+ (move-marker pt (point)))
+ (setq old-pt pt)
+ ;; Skip directional controls, if any.
+ (move-marker
+ pt (+ pt (skip-chars-forward bidi-directional-controls-chars limit))))))
+
+(defun squeeze-bidi-context (from to)
+ "Replace characters between FROM and TO while keeping bidi context.
+
+This function replaces the region of text with as few characters
+as possible, while preserving the effect that region will have on
+bidirectional display before and after the region."
+ (let ((start (set-marker (make-marker)
+ (if (> from 0) from (+ (point-max) from))))
+ (end (set-marker (make-marker) to))
+ ;; This is for when they copy text with read-only text
+ ;; properties.
+ (inhibit-read-only t))
+ (if (null (marker-position end))
+ (setq end (point-max-marker)))
+ ;; Replace each run of non-RTL characters with a single LRM.
+ (squeeze-bidi-context-1 start end "\\CR+" "\x200e")
+ ;; Replace each run of non-LTR characters with a single RLM. Note
+ ;; that the \cR category includes both the Arabic Letter (AL) and
+ ;; R characters; here we ignore the distinction between them,
+ ;; because that distinction only affects Arabic Number (AN)
+ ;; characters, which are weak and don't affect the reordering.
+ (squeeze-bidi-context-1 start end "\\CL+" "\x200f")))
+
+(defun line-substring-with-bidi-context (start end &optional no-properties)
+ "Return buffer text between START and END with its bidi context.
+
+START and END are assumed to belong to the same physical line
+of buffer text. This function prepends and appends to the text
+between START and END bidi control characters that preserve the
+visual order of that text when it is inserted at some other place."
+ (if (or (< start (point-min))
+ (> end (point-max)))
+ (signal 'args-out-of-range (list (current-buffer) start end)))
+ (let ((buf (current-buffer))
+ substr para-dir from to)
+ (save-excursion
+ (goto-char start)
+ (setq para-dir (current-bidi-paragraph-direction))
+ (setq from (line-beginning-position)
+ to (line-end-position))
+ (goto-char from)
+ ;; If we don't have any mixed directional characters in the
+ ;; entire line, we can just copy the substring without adding
+ ;; any context.
+ (if (or (looking-at-p "\\CR*$")
+ (looking-at-p "\\CL*$"))
+ (setq substr (if no-properties
+ (buffer-substring-no-properties start end)
+ (buffer-substring start end)))
+ (setq substr
+ (with-temp-buffer
+ (if no-properties
+ (insert-buffer-substring-no-properties buf from to)
+ (insert-buffer-substring buf from to))
+ (squeeze-bidi-context 1 (1+ (- start from)))
+ (squeeze-bidi-context (- end to) nil)
+ (buffer-substring 1 (point-max)))))
+
+ ;; Wrap the string in LRI/RLI..PDI pair to achieve 2 effects:
+ ;; (1) force the string to have the same base embedding
+ ;; direction as the paragraph direction at the source, no matter
+ ;; what is the paragraph direction at destination; and (2) avoid
+ ;; affecting the visual order of the surrounding text at
+ ;; destination if there are characters of different
+ ;; directionality there.
+ (concat (if (eq para-dir 'left-to-right) "\x2066" "\x2067")
+ substr "\x2069"))))
+
+(defun buffer-substring-with-bidi-context (start end &optional no-properties)
+ "Return portion of current buffer between START and END with bidi context.
+
+This function works similar to `buffer-substring', but it prepends and
+appends to the text bidi directional control characters necessary to
+preserve the visual appearance of the text if it is inserted at another
+place. This is useful when the buffer substring includes bidirectional
+text and control characters that cause non-trivial reordering on display.
+If copied verbatim, such text can have a very different visual appearance,
+and can also change the visual appearance of the surrounding text at the
+destination of the copy.
+
+Optional argument NO-PROPERTIES, if non-nil, means copy the text without
+the text properties."
+ (let (line-end substr)
+ (if (or (< start (point-min))
+ (> end (point-max)))
+ (signal 'args-out-of-range (list (current-buffer) start end)))
+ (save-excursion
+ (goto-char start)
+ (setq line-end (min end (line-end-position)))
+ (while (< start end)
+ (setq substr
+ (concat substr
+ (if substr "\n" "")
+ (line-substring-with-bidi-context start line-end
+ no-properties)))
+ (forward-line 1)
+ (setq start (point))
+ (setq line-end (min end (line-end-position))))
+ substr)))
\f
;; Yanking.
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)
(signal 'mark-inactive nil)))
;; Behind display-selections-p.
-(declare-function x-selection-owner-p "xselect.c"
- (&optional selection terminal))
-(declare-function x-selection-exists-p "xselect.c"
- (&optional selection terminal))
(defun deactivate-mark (&optional force)
"Deactivate the mark.
of the variable `transient-mark-mode'; if this causes Transient
Mark mode to be disabled, don't change `mark-active' to nil or
run `deactivate-mark-hook'."
- (when (or transient-mark-mode force)
+ (when (or (region-active-p) force)
(when (and (if (eq select-active-regions 'only)
(eq (car-safe transient-mark-mode) 'only)
select-active-regions)
;; the region prior to the last command modifying the buffer.
;; Set the selection to that, or to the current region.
(cond (saved-region-selection
- (x-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 (x-selection-owner-p 'PRIMARY)
- (null (x-selection-exists-p 'PRIMARY))))
- (x-set-selection 'PRIMARY
- (funcall region-extract-function nil)))))
+ (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).
(cond
((eq (car-safe transient-mark-mode) 'only)
- (setq transient-mark-mode (cdr transient-mark-mode)))
+ (setq transient-mark-mode (cdr transient-mark-mode))
+ (if (eq transient-mark-mode (default-value 'transient-mark-mode))
+ (kill-local-variable 'transient-mark-mode)))
((eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil)))
+ (kill-local-variable 'transient-mark-mode)))
(setq mark-active nil)
(run-hooks 'deactivate-mark-hook)
(redisplay--update-region-highlight (selected-window))))
(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))
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
(cond ((eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil))
+ (kill-local-variable 'transient-mark-mode))
((eq (car-safe transient-mark-mode) 'only)
(deactivate-mark)))
(cond
(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
(push-mark nil nil t)))
((eq (car-safe transient-mark-mode) 'only)
(setq transient-mark-mode (cdr transient-mark-mode))
+ (if (eq transient-mark-mode (default-value 'transient-mark-mode))
+ (kill-local-variable 'transient-mark-mode))
(deactivate-mark))))
(define-minor-mode transient-mark-mode
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.
0)
0)))
(if (floatp lsp)
- (setq lsp (* dfh lsp)))
+ (setq lsp (truncate (* (frame-char-height) lsp))))
(+ dfh lsp)))
(defun window-screen-lines ()
for `line-spacing', if any, defined for the window's buffer or frame.
The value is a floating-point number."
- (let ((canonical (window-text-height))
- (fch (frame-char-height))
+ (let ((edges (window-inside-pixel-edges))
(dlh (default-line-height)))
- (/ (* (float canonical) fch) dlh)))
+ (/ (float (- (nth 3 edges) (nth 1 edges))) dlh)))
;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror to-end)
`auto-window-vscroll' or TRY-VSCROLL is nil, this function will
not vscroll."
(if noninteractive
- (forward-line arg)
+ (line-move-1 arg noerror to-end)
(unless (and auto-window-vscroll try-vscroll
;; Only vscroll for single line moves
(= (abs arg) 1)
(> (cdr temporary-goal-column) 0))
(setq target-hscroll (cdr temporary-goal-column)))
;; Otherwise, we should reset `temporary-goal-column'.
- (let ((posn (posn-at-point)))
+ (let ((posn (posn-at-point))
+ x-pos)
(cond
;; Handle the `overflow-newline-into-fringe' case:
((eq (nth 1 posn) 'right-fringe)
(setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
((car (posn-x-y posn))
+ (setq x-pos (car (posn-x-y posn)))
+ ;; In R2L lines, the X pixel coordinate is measured from the
+ ;; left edge of the window, but columns are still counted
+ ;; from the logical-order beginning of the line, i.e. from
+ ;; the right edge in this case. We need to adjust for that.
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq x-pos (- (window-body-width nil t) 1 x-pos)))
(setq temporary-goal-column
- (cons (/ (float (car (posn-x-y posn)))
- (frame-char-width)) hscroll))))))
+ (cons (/ (float x-pos)
+ (frame-char-width))
+ hscroll))))))
(if target-hscroll
(set-window-hscroll (selected-window) target-hscroll))
;; vertical-motion can move more than it was asked to if it moves
;; 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))))))))
and drag it forward past ARG other characters (backward if ARG negative).
If no argument and at end of line, the previous two chars are exchanged."
(interactive "*P")
- (and (null arg) (eolp) (forward-char -1))
+ (when (and (null arg) (eolp) (not (bobp))
+ (not (get-text-property (1- (point)) 'read-only)))
+ (forward-char -1))
(transpose-subr 'forward-char (prefix-numeric-value arg)))
(defun transpose-words (arg)
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)
This is always done when called interactively.
Optional third arg NORECORD non-nil means do not put this buffer at the
-front of the list of recently selected ones."
+front of the list of recently selected ones.
+
+Returns the newly created indirect buffer."
(interactive
(progn
(if (get major-mode 'no-clone-indirect)
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.")