;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2016 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
(defun open-line (n)
"Insert a newline and leave point before it.
-If there is a fill prefix and/or a `left-margin', insert them
-on the new line if the line would have been blank.
+If there is a fill prefix and/or a `left-margin', insert them on
+the new line if the line would have been blank.
With arg N, insert N newlines."
(interactive "*p")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
(loc (point-marker))
- ;; Don't expand an abbrev before point.
+ ;; Don't expand an abbrev before point.
(abbrev-mode nil))
(newline n)
(goto-char loc)
(forward-line 1)
(setq n (1- n)))
(goto-char loc)
+ ;; Necessary in case a margin or prefix was inserted.
(end-of-line)))
(defun split-line (&optional arg)
(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)))
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
-If Transient Mark mode is disabled, leave mark at previous
-position, unless a \\[universal-argument] prefix is supplied."
+Push mark at previous position, unless either a \\[universal-argument] prefix
+is supplied, or Transient Mark mode is enabled and the mark is active."
(declare (interactive-only "use `(goto-char (point-min))' instead."))
(interactive "^P")
(or (consp arg)
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.
-If Transient Mark mode is disabled, leave mark at previous
-position, unless a \\[universal-argument] prefix is supplied."
+Push mark at previous position, unless either a \\[universal-argument] prefix
+is supplied, or Transient Mark mode is enabled and the mark is active."
(declare (interactive-only "use `(goto-char (point-max))' instead."))
(interactive "^P")
(or (consp arg) (region-active-p) (push-mark))
(defvar region-extract-function
(lambda (delete)
(when (region-beginning)
- (if (eq delete 'delete-only)
- (delete-region (region-beginning) (region-end))
- (filter-buffer-substring (region-beginning) (region-end) delete))))
+ (cond
+ ((eq delete 'bounds)
+ (list (cons (region-beginning) (region-end))))
+ ((eq delete 'delete-only)
+ (delete-region (region-beginning) (region-end)))
+ (t
+ (filter-buffer-substring (region-beginning) (region-end) delete)))))
"Function to get the region's content.
Called with one argument DELETE.
If DELETE is `delete-only', then only delete the region and the return value
is undefined. If DELETE is nil, just return the content as a string.
-If anything else, delete the region and return its content as a string.")
+If DELETE is `bounds', then don't delete, but just return the
+boundaries of the region as a list of (START . END) positions.
+If anything else, delete the region and return its content as a string,
+after filtering it with `filter-buffer-substring'.")
+
+(defvar region-insert-function
+ (lambda (lines)
+ (let ((first t))
+ (while lines
+ (or first
+ (insert ?\n))
+ (insert-for-yank (car lines))
+ (setq lines (cdr lines)
+ first nil))))
+ "Function to insert the region's content.
+Called with one argument LINES.
+Insert the region as a list of lines.")
(defun delete-backward-char (n &optional killflag)
"Delete the previous N characters (following if N is negative).
kill ring) instead of delete. Interactively, N is the prefix
arg, and KILLFLAG is set if N is explicitly specified.
+When killing, the killed text is filtered by
+`filter-buffer-substring' before it is saved in the kill ring, so
+the actual saved text might be different from what was killed.
+
In Overwrite mode, single character backward deletion may replace
tabs with spaces so as to back over columns, unless point is at
the end of the line."
Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete. Interactively, N is the prefix arg, and
-KILLFLAG is set if N was explicitly specified."
+KILLFLAG is set if N was explicitly specified.
+
+When killing, the killed text is filtered by
+`filter-buffer-substring' before it is saved in the kill ring, so
+the actual saved text might be different from what was killed."
(declare (interactive-only delete-char))
(interactive "p\nP")
(unless (integerp n)
(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.
(symbol-name function) typed))))
(when binding
(with-temp-message
- (format "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
+ (format-message "You can run the command `%s' with %s"
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))
a special event, so ignore the prefix argument and don't clear it."
(setq debug-on-next-call nil)
(let ((prefixarg (unless special
+ ;; FIXME: This should probably be done around
+ ;; pre-command-hook rather than here!
(prog1 prefix-arg
(setq current-prefix-arg prefix-arg)
- (setq prefix-arg nil)))))
+ (setq prefix-arg nil)
+ (when current-prefix-arg
+ (prefix-command-update))))))
(if (and (symbolp cmd)
(get cmd 'disabled)
disabled-command-function)
;; the end of the line when it fails to go to the next line.
(goto-char old-point)
(next-history-element arg)
+ ;; Reset `temporary-goal-column' because a correct value is not
+ ;; calculated when `next-line' above fails by bumping against
+ ;; the bottom of the minibuffer (bug#22544).
+ (setq temporary-goal-column 0)
;; Restore the original goal column on the last line
;; of possibly multi-line input.
(goto-char (point-max))
;; the beginning of the line when it fails to go to the previous line.
(goto-char old-point)
(previous-history-element arg)
+ ;; Reset `temporary-goal-column' because a correct value is not
+ ;; calculated when `previous-line' above fails by bumping against
+ ;; the top of the minibuffer (bug#22544).
+ (setq temporary-goal-column 0)
;; Restore the original goal column on the first line
;; of possibly multi-line input.
(goto-char (minibuffer-prompt-end))
(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)))))))
+ ;; Put the cursor at the end of the visual line instead of the
+ ;; logical line, so the next `previous-line-or-history-element'
+ ;; would move to the previous history element, not to a possible upper
+ ;; visual line from the end of logical line in `line-move-visual' mode.
+ (end-of-visual-line)
+ ;; Since `end-of-visual-line' puts the cursor at the beginning
+ ;; of the next visual line, move it one char back to the end
+ ;; of the first visual line (bug#22544).
+ (unless (eolp) (backward-char 1)))))))
(defun next-complete-history-element (n)
"Get next history element which completes the minibuffer before the point.
'(0 . 0)))
'(0 . 0)))
+;;; Default undo-boundary addition
+;;
+;; This section adds a new undo-boundary at either after a command is
+;; called or in some cases on a timer called after a change is made in
+;; any buffer.
+(defvar-local undo-auto--last-boundary-cause nil
+ "Describe the cause of the last undo-boundary.
+
+If `explicit', the last boundary was caused by an explicit call to
+`undo-boundary', that is one not called by the code in this
+section.
+
+If it is equal to `timer', then the last boundary was inserted
+by `undo-auto--boundary-timer'.
+
+If it is equal to `command', then the last boundary was inserted
+automatically after a command, that is by the code defined in
+this section.
+
+If it is equal to a list, then the last boundary was inserted by
+an amalgamating command. The car of the list is the number of
+times an amalgamating command has been called, and the cdr are the
+buffers that were changed during the last command.")
+
+(defvar undo-auto-current-boundary-timer nil
+ "Current timer which will run `undo-auto--boundary-timer' or nil.
+
+If set to non-nil, this will effectively disable the timer.")
+
+(defvar undo-auto--this-command-amalgamating nil
+ "Non-nil if `this-command' should be amalgamated.
+This variable is set to nil by `undo-auto--boundaries' and is set
+by `undo-auto-amalgamate'." )
+
+(defun undo-auto--needs-boundary-p ()
+ "Return non-nil if `buffer-undo-list' needs a boundary at the start."
+ (car-safe buffer-undo-list))
+
+(defun undo-auto--last-boundary-amalgamating-number ()
+ "Return the number of amalgamating last commands or nil.
+Amalgamating commands are, by default, either
+`self-insert-command' and `delete-char', but can be any command
+that calls `undo-auto-amalgamate'."
+ (car-safe undo-auto--last-boundary-cause))
+
+(defun undo-auto--ensure-boundary (cause)
+ "Add an `undo-boundary' to the current buffer if needed.
+REASON describes the reason that the boundary is being added; see
+`undo-auto--last-boundary' for more information."
+ (when (and
+ (undo-auto--needs-boundary-p))
+ (let ((last-amalgamating
+ (undo-auto--last-boundary-amalgamating-number)))
+ (undo-boundary)
+ (setq undo-auto--last-boundary-cause
+ (if (eq 'amalgamate cause)
+ (cons
+ (if last-amalgamating (1+ last-amalgamating) 0)
+ undo-auto--undoably-changed-buffers)
+ cause)))))
+
+(defun undo-auto--boundaries (cause)
+ "Check recently changed buffers and add a boundary if necessary.
+REASON describes the reason that the boundary is being added; see
+`undo-last-boundary' for more information."
+ (dolist (b undo-auto--undoably-changed-buffers)
+ (when (buffer-live-p b)
+ (with-current-buffer b
+ (undo-auto--ensure-boundary cause))))
+ (setq undo-auto--undoably-changed-buffers nil))
+
+(defun undo-auto--boundary-timer ()
+ "Timer which will run `undo--auto-boundary-timer'."
+ (setq undo-auto-current-boundary-timer nil)
+ (undo-auto--boundaries 'timer))
+
+(defun undo-auto--boundary-ensure-timer ()
+ "Ensure that the `undo-auto-boundary-timer' is set."
+ (unless undo-auto-current-boundary-timer
+ (setq undo-auto-current-boundary-timer
+ (run-at-time 10 nil #'undo-auto--boundary-timer))))
+
+(defvar undo-auto--undoably-changed-buffers nil
+ "List of buffers that have changed recently.
+
+This list is maintained by `undo-auto--undoable-change' and
+`undo-auto--boundaries' and can be affected by changes to their
+default values.
+
+See also `undo-auto--buffer-undoably-changed'.")
+
+(defun undo-auto--add-boundary ()
+ "Add an `undo-boundary' in appropriate buffers."
+ (undo-auto--boundaries
+ (let ((amal undo-auto--this-command-amalgamating))
+ (setq undo-auto--this-command-amalgamating nil)
+ (if amal
+ 'amalgamate
+ 'command))))
+
+(defun undo-auto-amalgamate ()
+ "Amalgamate undo if necessary.
+This function can be called before an amalgamating command. It
+removes the previous `undo-boundary' if a series of such calls
+have been made. By default `self-insert-command' and
+`delete-char' are the only amalgamating commands, although this
+function could be called by any command wishing to have this
+behavior."
+ (let ((last-amalgamating-count
+ (undo-auto--last-boundary-amalgamating-number)))
+ (setq undo-auto--this-command-amalgamating t)
+ (when
+ last-amalgamating-count
+ (if
+ (and
+ (< last-amalgamating-count 20)
+ (eq this-command last-command))
+ ;; Amalgamate all buffers that have changed.
+ (dolist (b (cdr undo-auto--last-boundary-cause))
+ (when (buffer-live-p b)
+ (with-current-buffer
+ b
+ (when
+ ;; The head of `buffer-undo-list' is nil.
+ ;; `car-safe' doesn't work because
+ ;; `buffer-undo-list' need not be a list!
+ (and (listp buffer-undo-list)
+ (not (car buffer-undo-list)))
+ (setq buffer-undo-list
+ (cdr buffer-undo-list))))))
+ (setq undo-auto--last-boundary-cause 0)))))
+
+(defun undo-auto--undoable-change ()
+ "Called after every undoable buffer change."
+ (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))
+ (undo-auto--boundary-ensure-timer))
+;; End auto-boundary section
+
(defcustom undo-ask-before-discard nil
"If non-nil ask about discarding undo info for the current command.
Normally, Emacs discards the undo info for the current command if
;; but we don't want to ask the question again.
(setq undo-extra-outer-limit (+ size 50000))
(if (let (use-dialog-box track-mouse executing-kbd-macro )
- (yes-or-no-p (format "Buffer `%s' undo info is %d bytes long; discard it? "
- (buffer-name) size)))
+ (yes-or-no-p (format-message
+ "Buffer `%s' undo info is %d bytes long; discard it? "
+ (buffer-name) size)))
(progn (setq buffer-undo-list nil)
(setq undo-extra-outer-limit nil)
t)
nil))
(display-warning '(undo discard-info)
(concat
- (format "Buffer `%s' undo info was %d bytes long.\n"
- (buffer-name) size)
+ (format-message
+ "Buffer `%s' undo info was %d bytes long.\n"
+ (buffer-name) size)
"The undo info was discarded because it exceeded \
`undo-outer-limit'.
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
-(defun display-message-or-buffer (message
- &optional buffer-name not-this-window frame)
+(defun display-message-or-buffer (message &optional buffer-name action frame)
"Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
MESSAGE may be either a string or a buffer.
-A buffer is displayed using `display-buffer' if MESSAGE is too long for
-the maximum height of the echo area, as defined by `max-mini-window-height'
+A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long
+for maximum height of the echo area, as defined by `max-mini-window-height'
if `resize-mini-windows' is non-nil.
Returns either the string shown in the echo area, or when a pop-up
string and it is displayed in the echo area, it is not specified whether
the contents are inserted into the buffer anyway.
-Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
-and only used if a buffer is displayed."
+Optional arguments ACTION and FRAME are as for `display-buffer',
+and are only used if a pop-up buffer is displayed."
(cond ((and (stringp message) (not (string-match "\n" message)))
;; Trivial case where we can use the echo area
(message "%s" message))
(t
;; Buffer
(goto-char (point-min))
- (display-buffer (current-buffer)
- not-this-window frame))))))))
+ (display-buffer (current-buffer) action frame))))))))
;; We have a sentinel to prevent insertion of a termination message
(defun shell-command-on-region (start end command
&optional output-buffer replace
- error-buffer display-error-buffer)
+ error-buffer display-error-buffer
+ region-noncontiguous-p)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of
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.
current-prefix-arg
current-prefix-arg
shell-command-default-error-buffer
- t)))
+ t
+ (region-noncontiguous-p))))
(let ((error-file
(if error-buffer
(make-temp-file
temporary-file-directory)))
nil))
exit-status)
- (if (or replace
- (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer)))))
- ;; Replace specified region with output from command.
- (let ((swap (and replace (< start end))))
- ;; Don't muck with mark unless REPLACE says we should.
- (goto-char start)
- (and replace (push-mark (point) 'nomsg))
- (setq exit-status
- (call-process-region start end shell-file-name replace
- (if error-file
- (list t error-file)
- t)
- nil shell-command-switch command))
- ;; It is rude to delete a buffer which the command is not using.
- ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
- ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
- ;; (kill-buffer shell-buffer)))
- ;; Don't muck with mark unless REPLACE says we should.
- (and replace swap (exchange-point-and-mark)))
- ;; No prefix argument: put the output in a temp buffer,
- ;; replacing its entire contents.
- (let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*"))))
- (unwind-protect
- (if (eq buffer (current-buffer))
- ;; If the input is the same buffer as the output,
- ;; delete everything but the specified region,
- ;; then replace that region with the output.
- (progn (setq buffer-read-only nil)
- (delete-region (max start end) (point-max))
- (delete-region (point-min) (min start end))
- (setq exit-status
- (call-process-region (point-min) (point-max)
- shell-file-name t
- (if error-file
- (list t error-file)
- t)
- nil shell-command-switch
- command)))
- ;; Clear the output buffer, then run the command with
- ;; output there.
- (let ((directory default-directory))
- (with-current-buffer buffer
- (setq buffer-read-only nil)
- (if (not output-buffer)
- (setq default-directory directory))
- (erase-buffer)))
- (setq exit-status
- (call-process-region start end shell-file-name nil
- (if error-file
- (list buffer error-file)
- buffer)
- nil shell-command-switch command)))
- ;; Report the output.
- (with-current-buffer buffer
- (setq mode-line-process
- (cond ((null exit-status)
- " - Error")
- ((stringp exit-status)
- (format " - Signal [%s]" exit-status))
- ((not (equal 0 exit-status))
- (format " - Exit [%d]" exit-status)))))
- (if (with-current-buffer buffer (> (point-max) (point-min)))
- ;; There's some output, display it
- (display-message-or-buffer buffer)
- ;; No output; error?
- (let ((output
- (if (and error-file
- (< 0 (nth 7 (file-attributes error-file))))
- (format "some error output%s"
- (if shell-command-default-error-buffer
- (format " to the \"%s\" buffer"
- shell-command-default-error-buffer)
- ""))
- "no output")))
- (cond ((null exit-status)
- (message "(Shell command failed with error)"))
- ((equal 0 exit-status)
- (message "(Shell command succeeded with %s)"
- output))
- ((stringp exit-status)
- (message "(Shell command killed by signal %s)"
- exit-status))
- (t
- (message "(Shell command failed with code %d and %s)"
- exit-status output))))
- ;; Don't kill: there might be useful info in the undo-log.
- ;; (kill-buffer buffer)
- ))))
+ ;; Unless a single contiguous chunk is selected, operate on multiple chunks.
+ (if region-noncontiguous-p
+ (let ((input (concat (funcall region-extract-function 'delete) "\n"))
+ output)
+ (with-temp-buffer
+ (insert input)
+ (call-process-region (point-min) (point-max)
+ shell-file-name t t
+ nil shell-command-switch
+ command)
+ (setq output (split-string (buffer-string) "\n")))
+ (goto-char start)
+ (funcall region-insert-function output))
+ (if (or replace
+ (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer)))))
+ ;; Replace specified region with output from command.
+ (let ((swap (and replace (< start end))))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (goto-char start)
+ (and replace (push-mark (point) 'nomsg))
+ (setq exit-status
+ (call-process-region start end shell-file-name replace
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command))
+ ;; It is rude to delete a buffer which the command is not using.
+ ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ ;; (kill-buffer shell-buffer)))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (and replace swap (exchange-point-and-mark)))
+ ;; No prefix argument: put the output in a temp buffer,
+ ;; replacing its entire contents.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell Command Output*"))))
+ (unwind-protect
+ (if (eq buffer (current-buffer))
+ ;; If the input is the same buffer as the output,
+ ;; delete everything but the specified region,
+ ;; then replace that region with the output.
+ (progn (setq buffer-read-only nil)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
+ (setq exit-status
+ (call-process-region (point-min) (point-max)
+ shell-file-name t
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch
+ command)))
+ ;; Clear the output buffer, then run the command with
+ ;; output there.
+ (let ((directory default-directory))
+ (with-current-buffer buffer
+ (setq buffer-read-only nil)
+ (if (not output-buffer)
+ (setq default-directory directory))
+ (erase-buffer)))
+ (setq exit-status
+ (call-process-region start end shell-file-name nil
+ (if error-file
+ (list buffer error-file)
+ buffer)
+ nil shell-command-switch command)))
+ ;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (cond ((null exit-status)
+ " - Error")
+ ((stringp exit-status)
+ (format " - Signal [%s]" exit-status))
+ ((not (equal 0 exit-status))
+ (format " - Exit [%d]" exit-status)))))
+ (if (with-current-buffer buffer (> (point-max) (point-min)))
+ ;; There's some output, display it
+ (display-message-or-buffer buffer)
+ ;; No output; error?
+ (let ((output
+ (if (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ (format "some error output%s"
+ (if shell-command-default-error-buffer
+ (format " to the \"%s\" buffer"
+ shell-command-default-error-buffer)
+ ""))
+ "no output")))
+ (cond ((null exit-status)
+ (message "(Shell command failed with error)"))
+ ((equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output))
+ ((stringp exit-status)
+ (message "(Shell command killed by signal %s)"
+ exit-status))
+ (t
+ (message "(Shell command failed with code %d and %s)"
+ exit-status output))))
+ ;; Don't kill: there might be useful info in the undo-log.
+ ;; (kill-buffer buffer)
+ )))))
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
(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)
(buf-label (if (buffer-live-p buf)
`(,(buffer-name buf)
face link
- help-echo ,(concat "Visit buffer `"
- (buffer-name buf) "'")
+ help-echo ,(format-message
+ "Visit buffer `%s'"
+ (buffer-name buf))
follow-link t
process-buffer ,buf
action process-menu-visit-buffer)
(display-buffer buffer)
nil)
\f
+;;;; Prefix commands
+
+(setq prefix-command--needs-update nil)
+(setq prefix-command--last-echo nil)
+
+(defun internal-echo-keystrokes-prefix ()
+ ;; BEWARE: Called directly from C code.
+ ;; If the return value is non-nil, it means we are in the middle of
+ ;; a command with prefix, such as a command invoked with prefix-arg.
+ (if (not prefix-command--needs-update)
+ prefix-command--last-echo
+ (setq prefix-command--last-echo
+ (let ((strs nil))
+ (run-hook-wrapped 'prefix-command-echo-keystrokes-functions
+ (lambda (fun) (push (funcall fun) strs)))
+ (setq strs (delq nil strs))
+ (when strs (mapconcat #'identity strs " "))))))
+
+(defvar prefix-command-echo-keystrokes-functions nil
+ "Abnormal hook which constructs the description of the current prefix state.
+Each function is called with no argument, should return a string or nil.")
+
+(defun prefix-command-update ()
+ "Update state of prefix commands.
+Call it whenever you change the \"prefix command state\"."
+ (setq prefix-command--needs-update t))
+
+(defvar prefix-command-preserve-state-hook nil
+ "Normal hook run when a command needs to preserve the prefix.")
+
+(defun prefix-command-preserve-state ()
+ "Pass the current prefix command state to the next command.
+Should be called by all prefix commands.
+Runs `prefix-command-preserve-state-hook'."
+ (run-hooks 'prefix-command-preserve-state-hook)
+ ;; If the current command is a prefix command, we don't want the next (real)
+ ;; command to have `last-command' set to, say, `universal-argument'.
+ (setq this-command last-command)
+ (setq real-this-command real-last-command)
+ (prefix-command-update))
+
+(defun reset-this-command-lengths ()
+ (declare (obsolete prefix-command-preserve-state "25.1"))
+ nil)
+
+;;;;; The main prefix command.
+
+;; FIXME: Declaration of `prefix-arg' should be moved here!?
+
+(add-hook 'prefix-command-echo-keystrokes-functions
+ #'universal-argument--description)
+(defun universal-argument--description ()
+ (when prefix-arg
+ (concat "C-u"
+ (pcase prefix-arg
+ (`(-) " -")
+ (`(,(and (pred integerp) n))
+ (let ((str ""))
+ (while (and (> n 4) (= (mod n 4) 0))
+ (setq str (concat str " C-u"))
+ (setq n (/ n 4)))
+ (if (= n 4) str (format " %s" prefix-arg))))
+ (_ (format " %s" prefix-arg))))))
+
+(add-hook 'prefix-command-preserve-state-hook
+ #'universal-argument--preserve)
+(defun universal-argument--preserve ()
+ (setq prefix-arg current-prefix-arg))
+
(defvar universal-argument-map
(let ((map (make-sparse-keymap))
(universal-argument-minus
"Keymap used while processing \\[universal-argument].")
(defun universal-argument--mode ()
- (set-transient-map universal-argument-map))
+ (prefix-command-update)
+ (set-transient-map universal-argument-map nil))
(defun universal-argument ()
"Begin a numeric argument for the following command.
which is different in effect from any particular numeric argument.
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
+ (prefix-command-preserve-state)
(setq prefix-arg (list 4))
(universal-argument--mode))
;; A subsequent C-u means to multiply the factor by 4 if we've typed
;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(interactive "P")
+ (prefix-command-preserve-state)
(setq prefix-arg (if (consp arg)
(list (* 4 (car arg)))
(if (eq arg '-)
"Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
+ (prefix-command-preserve-state)
(setq prefix-arg (cond ((integerp arg) (- arg))
((eq arg '-) nil)
(t '-)))
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
+ (prefix-command-preserve-state)
(let* ((char (if (integerp last-command-event)
last-command-event
(get last-command-event 'ascii-character)))
If you want to append the killed region to the last killed text,
use \\[append-next-kill] before \\[kill-region].
+Any command that calls this function is a \"kill command\".
+If the previous command was also a kill command,
+the text killed this time appends to the text killed last time
+to make one entry in the kill ring.
+
+The killed text is filtered by `filter-buffer-substring' before it is
+saved in the kill ring, so the actual saved text might be different
+from what was killed.
+
If the buffer is read-only, Emacs will beep and refrain from deleting
the text, but put the text in the kill ring anyway. This means that
you can use the killing commands to copy text from a read-only buffer.
Lisp programs should use this function for killing text.
(To delete text, use `delete-region'.)
-Supply two arguments, character positions indicating the stretch of text
- to be killed.
-Any command that calls this function is a \"kill command\".
-If the previous command was also a kill command,
-the text killed this time appends to the text killed last time
-to make one entry in the kill ring.
-
-The optional argument REGION if non-nil, indicates that we're not just killing
-some text between BEG and END, but we're killing the region."
+Supply two arguments, character positions BEG and END indicating the
+ stretch of text to be killed. If the optional argument REGION is
+ non-nil, the function ignores BEG and END, and kills the current
+ region instead."
;; Pass mark first, then point, because the order matters when
;; 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)
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.
-The optional argument REGION if non-nil, indicates that we're not just copying
-some text between BEG and END, but we're copying the region.
+The copied text is filtered by `filter-buffer-substring' before it is
+saved in the kill ring, so the actual saved text might be different
+from what was in the buffer.
+
+When called from Lisp, save in the kill ring the stretch of text
+between BEG and END, unless the optional argument REGION is
+non-nil, in which case ignore BEG and END, and save the current
+region instead.
This command's old key binding has been given to `kill-ring-save'."
;; Pass mark first, then point, because the order matters when
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-ring-save].
-The optional argument REGION if non-nil, indicates that we're not just copying
-some text between BEG and END, but we're copying the region.
+The copied text is filtered by `filter-buffer-substring' before it is
+saved in the kill ring, so the actual saved text might be different
+from what was in the buffer.
+
+When called from Lisp, save in the kill ring the stretch of text
+between BEG and END, unless the optional argument REGION is
+non-nil, in which case ignore BEG and END, and save the current
+region instead.
This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
;; region is active when there's no mark.
(progn (cl-assert (mark)) t)))
+(defun region-noncontiguous-p ()
+ "Return non-nil if the region contains several pieces.
+An example is a rectangular region handled as a list of
+separate contiguous regions for each line."
+ (> (length (funcall region-extract-function 'bounds)) 1))
(defvar redisplay-unhighlight-region-function
(lambda (rol) (when (overlayp rol) (delete-overlay rol))))
(setq pos1 (funcall aux -1))
(goto-char (car pos1))
(setq pos2 (funcall aux arg))
- (transpose-subr-1 pos1 pos2)))))
+ (transpose-subr-1 pos1 pos2)
+ (goto-char (+ (car pos2) (- (cdr pos1) (car pos1))))))))
(defun transpose-subr-1 (pos1 pos2)
(when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
(defcustom blink-matching-paren t
"Non-nil means show matching open-paren when close-paren is inserted.
-If t, highlight the paren. If `jump', move cursor to its position."
+If t, highlight the paren. If `jump', briefly move cursor to its
+position. If `jump-offscreen', move cursor there even if the
+position is off screen. With any other non-nil value, the
+off-screen position of the opening paren will be shown in the
+echo area."
:type '(choice
(const :tag "Disable" nil)
(const :tag "Highlight" t)
- (const :tag "Move cursor" jump))
+ (const :tag "Move cursor" jump)
+ (const :tag "Move cursor, even if off screen" jump-offscreen))
:group 'paren-blinking)
(defcustom blink-matching-paren-on-screen t
"Non-nil means show matching open-paren when it is on screen.
If nil, don't show it (but the open-paren can still be shown
-when it is off screen).
+in the echo area when it is off screen).
This variable has no effect if `blink-matching-paren' is nil.
\(In that case, the open-paren is never shown.)
(minibuffer-message "No matching parenthesis found")
(message "No matching parenthesis found"))))
((not blinkpos) nil)
- ((pos-visible-in-window-p blinkpos)
+ ((or
+ (eq blink-matching-paren 'jump-offscreen)
+ (pos-visible-in-window-p blinkpos))
;; Matching open within window, temporarily move to or highlight
;; char after blinkpos but only if `blink-matching-paren-on-screen'
;; is non-nil.
(and blink-matching-paren-on-screen
(not show-paren-mode)
- (if (eq blink-matching-paren 'jump)
+ (if (memq blink-matching-paren '(jump jump-offscreen))
(save-excursion
(goto-char blinkpos)
(sit-for blink-matching-delay))
(sit-for blink-matching-delay))
(delete-overlay blink-matching--overlay)))))
(t
- (save-excursion
- (goto-char blinkpos)
- (let ((open-paren-line-string
+ (let ((open-paren-line-string
+ (save-excursion
+ (goto-char blinkpos)
;; Show what precedes the open in its line, if anything.
(cond
((save-excursion (skip-chars-backward " \t") (not (bolp)))
"..."
(buffer-substring blinkpos (1+ blinkpos))))
;; There is nothing to show except the char itself.
- (t (buffer-substring blinkpos (1+ blinkpos))))))
- (minibuffer-message
- "Matches %s"
- (substring-no-properties open-paren-line-string)))))))))
+ (t (buffer-substring blinkpos (1+ blinkpos)))))))
+ (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.
(push var warn-vars)))
(when warn-vars
(display-warning 'mail
- (format "\
+ (format-message "\
The default mail mode is now Message mode.
You have the following Mail mode variable%s customized:
\n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent.
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"))))))
If set to nil, both Delete and Backspace keys delete backward.
-If set to 'maybe (which is the default), Emacs automatically
+If set to `maybe' (which is the default), Emacs automatically
selects a behavior. On window systems, the behavior depends on
the keyboard used. If the keyboard has both a Backspace key and
a Delete key, and both are mapped to their usual meanings, the
(interactive "P")
(when (or arg (null ,varimp-sym))
(let ((val (completing-read
- ,(format "Select implementation for command `%s': "
- command-name)
+ ,(format-message
+ "Select implementation for command `%s': "
+ command-name)
,varalt-sym nil t)))
(unless (string-equal val "")
(when (null ,varimp-sym)
(message
- "Use `C-u M-x %s RET' to select another implementation"
+ "Use C-u M-x %s RET`to select another implementation"
,command-name)
(sit-for 3))
(customize-save-variable ',varimp-sym
(cdr (assoc-string val ,varalt-sym))))))
(if ,varimp-sym
(call-interactively ,varimp-sym)
- (message ,(format "No implementation selected for command `%s'"
- command-name)))))))
+ (message "%s" ,(format-message
+ "No implementation selected for command `%s'"
+ command-name)))))))
+
+\f
+;;; Functions for changing capitalization that Do What I Mean
+(defun upcase-dwim (arg)
+ "Upcase words in the region, if active; if not, upcase word at point.
+If the region is active, this function calls `upcase-region'.
+Otherwise, it calls `upcase-word', with prefix argument passed to it
+to upcase ARG words."
+ (interactive "*p")
+ (if (use-region-p)
+ (upcase-region (region-beginning) (region-end))
+ (upcase-word arg)))
+
+(defun downcase-dwim (arg)
+ "Downcase words in the region, if active; if not, downcase word at point.
+If the region is active, this function calls `downcase-region'.
+Otherwise, it calls `downcase-word', with prefix argument passed to it
+to downcase ARG words."
+ (interactive "*p")
+ (if (use-region-p)
+ (downcase-region (region-beginning) (region-end))
+ (downcase-word arg)))
+
+(defun capitalize-dwim (arg)
+ "Capitalize words in the region, if active; if not, capitalize word at point.
+If the region is active, this function calls `capitalize-region'.
+Otherwise, it calls `capitalize-word', with prefix argument passed to it
+to capitalize ARG words."
+ (interactive "*p")
+ (if (use-region-p)
+ (capitalize-region (region-beginning) (region-end))
+ (capitalize-word arg)))
\f