;;; 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.
;; 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)))
+ (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?
+ (setq-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
(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.
- (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)))
+ ;; (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.
+ ;; FIXME: Wait *after* running post-command-hook!
+ ;; FIXME: Don't wait if execute-extended-command--shorter won't
+ ;; find a better answer anyway!
+ (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)))
+ (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))))))))
(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)))
+ (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)))))
+
+(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)))
+ (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)))))
+
(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
;; 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? ")
;;;; 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
(if interprogram-cut-function
(funcall interprogram-cut-function string)))
+;; It has been argued that this should work similar to `self-insert-command'
+;; which merges insertions in undo-list in groups of 20 (hard-coded in cmds.c).
+(defcustom kill-append-merge-undo nil
+ "Whether appending to kill ring also makes \\[undo] restore both pieces of text simultaneously."
+ :type 'boolean
+ :group 'killing
+ :version "25.1")
+
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
+Also removes the last undo boundary in the current buffer,
+ depending on `kill-append-merge-undo'.
If `interprogram-cut-function' is set, pass the resulting kill to it."
(let* ((cur (car kill-ring)))
(kill-new (if before-p (concat string cur) (concat cur string))
(or (= (length cur) 0)
- (equal nil (get-text-property 0 'yank-handler cur))))))
+ (equal nil (get-text-property 0 'yank-handler cur))))
+ (when (and kill-append-merge-undo (not buffer-read-only))
+ (let ((prev buffer-undo-list)
+ (next (cdr buffer-undo-list)))
+ ;; find the next undo boundary
+ (while (car next)
+ (pop next)
+ (pop prev))
+ ;; remove this undo boundary
+ (when prev
+ (setcdr prev (cdr next)))))))
(defcustom yank-pop-change-selection nil
"Whether rotating the kill ring changes the window system selection.
(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))))
(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)
+ (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-call gui-selection-owner-p 'PRIMARY)
+ (null (gui-call gui-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))))
(force-mode-line-update) ;Refresh toolbar (bug#16382).
(setq mark-active t)
(unless (or transient-mark-mode no-tmm)
- (setq transient-mark-mode 'lambda))
+ (setq-local transient-mark-mode 'lambda))
(run-hooks 'activate-mark-hook))))
(defun set-mark (pos)
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
(set-mark (point))
(goto-char omark)
(cond (temp-highlight
- (setq transient-mark-mode (cons 'only transient-mark-mode)))
+ (setq-local transient-mark-mode (cons 'only transient-mark-mode)))
((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
(not (or arg (region-active-p))))
(deactivate-mark))
(cond ((and shift-select-mode this-command-keys-shift-translated)
(unless (and mark-active
(eq (car-safe transient-mark-mode) 'only))
- (setq transient-mark-mode
- (cons 'only
- (unless (eq transient-mark-mode 'lambda)
- transient-mark-mode)))
+ (setq-local transient-mark-mode
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode)))
(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
or \"mark.*active\" at the prompt."
:global t
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
- :variable transient-mark-mode)
+ :variable (default-value 'transient-mark-mode))
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
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)
((car (posn-x-y posn))
(setq temporary-goal-column
(cons (/ (float (car (posn-x-y posn)))
- (frame-char-width)) hscroll))))))
+ (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
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)
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)