-;;; simple.el --- basic editing commands for Emacs
+;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
Other major modes are defined by comparison with this one."
(interactive)
(kill-all-local-variables)
- (unless delay-mode-hooks
- (run-hooks 'after-change-major-mode-hook)))
+ (run-mode-hooks))
;; Special major modes to view specially formatted data rather than files.
(suppress-keymap map)
(define-key map "q" 'quit-window)
(define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
(define-key map "\C-?" 'scroll-down-command)
(define-key map "?" 'describe-mode)
(define-key map "h" 'describe-mode)
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
-If `use-hard-newlines' is non-nil, the newline is marked with the
+If option `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
With ARG, insert that many newlines.
Call `auto-fill-function' if the current column number is greater
(defun just-one-space (&optional n)
"Delete all spaces and tabs around point, leaving one space (or N spaces).
-If N is negative, delete newlines as well."
+If N is negative, delete newlines as well, leaving -N spaces."
(interactive "*p")
- (unless n (setq n 1))
- (let ((orig-pos (point))
- (skip-characters (if (< n 0) " \t\n\r" " \t"))
- (n (abs n)))
- (skip-chars-backward skip-characters)
+ (cycle-spacing n nil t))
+
+(defvar cycle-spacing--context nil
+ "Store context used in consecutive calls to `cycle-spacing' command.
+The first time this function is run, it saves the original point
+position and original spacing around the point in this
+variable.")
+
+(defun cycle-spacing (&optional n preserve-nl-back single-shot)
+ "Manipulate spaces around the point in a smart way.
+
+When run as an interactive command, the first time it's called
+in a sequence, deletes all spaces and tabs around point leaving
+one (or N spaces). If this does not change content of the
+buffer, skips to the second step:
+
+When run for the second time in a sequence, deletes all the
+spaces it has previously inserted.
+
+When run for the third time, returns the whitespace and point in
+a state encountered when it had been run for the first time.
+
+For example, if buffer contains \"foo ^ bar\" with \"^\" denoting the
+point, calling `cycle-spacing' command will replace two spaces with
+a single space, calling it again immediately after, will remove all
+spaces, and calling it for the third time will bring two spaces back
+together.
+
+If N is negative, delete newlines as well. However, if
+PRESERVE-NL-BACK is t new line characters prior to the point
+won't be removed.
+
+If SINGLE-SHOT is non-nil, will only perform the first step. In
+other words, it will work just like `just-one-space' command."
+ (interactive "*p")
+ (let ((orig-pos (point))
+ (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
+ (n (abs (or n 1))))
+ (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
(constrain-to-field nil orig-pos)
- (dotimes (i n)
- (if (= (following-char) ?\s)
- (forward-char 1)
- (insert ?\s)))
- (delete-region
- (point)
- (progn
- (skip-chars-forward skip-characters)
- (constrain-to-field nil orig-pos t)))))
+ (cond
+ ;; Command run for the first time or single-shot is non-nil.
+ ((or single-shot
+ (not (equal last-command this-command))
+ (not cycle-spacing--context))
+ (let* ((start (point))
+ (n (- n (skip-chars-forward " " (+ n (point)))))
+ (mid (point))
+ (end (progn
+ (skip-chars-forward skip-characters)
+ (constrain-to-field nil orig-pos t))))
+ (setq cycle-spacing--context ;; Save for later.
+ ;; Special handling for case where there was no space at all.
+ (unless (= start end)
+ (cons orig-pos (buffer-substring start (point)))))
+ ;; If this run causes no change in buffer content, delete all spaces,
+ ;; otherwise delete all excess spaces.
+ (delete-region (if (and (not single-shot) (zerop n) (= mid end))
+ start mid) end)
+ (insert (make-string n ?\s))))
+
+ ;; Command run for the second time.
+ ((not (equal orig-pos (point)))
+ (delete-region (point) orig-pos))
+
+ ;; Command run for the third time.
+ (t
+ (insert (cdr cycle-spacing--context))
+ (goto-char (car cycle-spacing--context))
+ (setq cycle-spacing--context nil)))))
\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer.
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
(cond ((and arg (not (consp arg))) (forward-line 1))
- ((> (point) (window-end nil t))
+ ((and (eq (current-buffer) (window-buffer))
+ (> (point) (window-end nil t)))
;; If the end of the buffer is not already on the screen,
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
"Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
-To disable this, set `delete-active-region' to nil.
+To disable this, set option `delete-active-region' to nil.
Optional second arg KILLFLAG, if non-nil, means to kill (save in
kill ring) instead of delete. Interactively, N is the prefix
"Delete the following N characters (previous if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
-To disable this, set `delete-active-region' to nil.
+To disable this, set variable `delete-active-region' to nil.
Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete. Interactively, N is the prefix arg, and
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-buffer.
-(defun eval-expression (eval-expression-arg
- &optional eval-expression-insert-value)
- "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
+(defun eval-expression (exp &optional insert-value)
+ "Evaluate EXP and print value in the echo area.
When called interactively, read an Emacs Lisp expression and
evaluate it.
Value is also consed on to front of the variable `values'.
-Optional argument EVAL-EXPRESSION-INSERT-VALUE non-nil (interactively,
+Optional argument INSERT-VALUE non-nil (interactively,
with prefix argument) means insert the result into the current buffer
instead of printing it in the echo area. Truncates long output
according to the value of the variables `eval-expression-print-length'
current-prefix-arg))
(if (null eval-expression-debug-on-error)
- (push (eval eval-expression-arg lexical-binding) values)
+ (push (eval exp lexical-binding) values)
(let ((old-value (make-symbol "t")) new-value)
;; 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 eval-expression-arg lexical-binding) values)
+ (push (eval 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.
(setq debug-on-error new-value))))
(let ((print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
- (if eval-expression-insert-value
+ (print-level eval-expression-print-level)
+ (deactivate-mark))
+ (if insert-value
(with-no-warnings
(let ((standard-output (current-buffer)))
(prin1 (car values))))
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+(defvar extended-command-history nil)
+
(defun read-extended-command ()
"Read command name to invoke in `execute-extended-command'."
(minibuffer-with-setup-hook
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
"Read function name, then read its arguments and call it.
-To pass a numeric argument to the command you are invoking with, specify
+To pass a numeric argument to the command you are invoking, specify
the numeric argument to this command.
Noninteractively, the argument PREFIXARG is the prefix argument to
give to the command you invoke, if it asks for an argument."
(interactive (list current-prefix-arg (read-extended-command)))
;; Emacs<24 calling-convention was with a single `prefixarg' argument.
- (if (null command-name) (setq command-name (read-extended-command)))
+ (if (null command-name)
+ (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
+ (read-extended-command))))
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
(not executing-kbd-macro)
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))
+
+(defun command-execute (cmd &optional record-flag keys special)
+ ;; BEWARE: Called directly from the C code.
+ "Execute CMD as an editor command.
+CMD must be a symbol that satisfies the `commandp' predicate.
+Optional second arg RECORD-FLAG non-nil
+means unconditionally put this command in the variable `command-history'.
+Otherwise, that is done only if an arg is read using the minibuffer.
+The argument KEYS specifies the value to use instead of (this-command-keys)
+when reading the arguments; if it is nil, (this-command-keys) is used.
+The argument SPECIAL, if non-nil, means that this command is executing
+a special event, so ignore the prefix argument and don't clear it."
+ (setq debug-on-next-call nil)
+ (let ((prefixarg (unless special
+ (prog1 prefix-arg
+ (setq current-prefix-arg prefix-arg)
+ (setq prefix-arg nil)))))
+ (and (symbolp cmd)
+ (get cmd 'disabled)
+ ;; FIXME: Weird calling convention!
+ (run-hooks 'disabled-command-function))
+ (let ((final cmd))
+ (while
+ (progn
+ (setq final (indirect-function final))
+ (if (autoloadp final)
+ (setq final (autoload-do-load final cmd)))))
+ (cond
+ ((arrayp final)
+ ;; If requested, place the macro in the command history. For
+ ;; other sorts of commands, call-interactively takes care of this.
+ (when record-flag
+ (push `(execute-kbd-macro ,final ,prefixarg) command-history)
+ ;; Don't keep command history around forever.
+ (when (and (numberp history-length) (> history-length 0))
+ (let ((cell (nthcdr history-length command-history)))
+ (if (consp cell) (setcdr cell nil)))))
+ (execute-kbd-macro final prefixarg))
+ (t
+ ;; Pass `cmd' rather than `final', for the backtrace's sake.
+ (prog1 (call-interactively cmd record-flag keys)
+ (when (and (symbolp cmd)
+ (get cmd 'byte-obsolete-info)
+ (not (get cmd 'command-execute-obsolete-warned)))
+ (put cmd 'command-execute-obsolete-warned t)
+ (message "%s" (macroexp--obsolete-warning
+ cmd (get cmd 'byte-obsolete-info) "command")))))))))
\f
(defvar minibuffer-history nil
"Default minibuffer history list.
If there are no search errors, this function displays an overlay with
the isearch prompt which replaces the original minibuffer prompt.
Otherwise, it displays the standard isearch message returned from
-`isearch-message'."
+the function `isearch-message'."
(if (not (and (minibufferp) isearch-success (not isearch-error)))
;; Use standard function `isearch-message' when not in the minibuffer,
;; or search fails, or has an error (like incomplete regexp).
"Save a function restoring the state of minibuffer history search.
Save `minibuffer-history-position' to the additional state parameter
in the search status stack."
- `(lambda (cmd)
- (minibuffer-history-isearch-pop-state cmd ,minibuffer-history-position)))
+ (let ((pos minibuffer-history-position))
+ (lambda (cmd)
+ (minibuffer-history-isearch-pop-state cmd pos))))
(defun minibuffer-history-isearch-pop-state (_cmd hist-pos)
"Restore the minibuffer history search state.
(if (null pending-undo-list)
(setq pending-undo-list t))))
+(defun primitive-undo (n list)
+ "Undo N records from the front of the list LIST.
+Return what remains of the list."
+
+ ;; This is a good feature, but would make undo-start
+ ;; unable to do what is expected.
+ ;;(when (null (car (list)))
+ ;; ;; If the head of the list is a boundary, it is the boundary
+ ;; ;; preceding this command. Get rid of it and don't count it.
+ ;; (setq list (cdr list))))
+
+ (let ((arg n)
+ ;; In a writable buffer, enable undoing read-only text that is
+ ;; so because of text properties.
+ (inhibit-read-only t)
+ ;; Don't let `intangible' properties interfere with undo.
+ (inhibit-point-motion-hooks t)
+ ;; We use oldlist only to check for EQ. ++kfs
+ (oldlist buffer-undo-list)
+ (did-apply nil)
+ (next nil))
+ (while (> arg 0)
+ (while (setq next (pop list)) ;Exit inner loop at undo boundary.
+ ;; Handle an integer by setting point to that value.
+ (pcase next
+ ((pred integerp) (goto-char next))
+ ;; Element (t . TIME) records previous modtime.
+ ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+ ;; UNKNOWN_MODTIME_NSECS.
+ (`(t . ,time)
+ ;; If this records an obsolete save
+ ;; (not matching the actual disk file)
+ ;; then don't mark unmodified.
+ (when (or (equal time (visited-file-modtime))
+ (and (consp time)
+ (equal (list (car time) (cdr time))
+ (visited-file-modtime))))
+ (when (fboundp 'unlock-buffer)
+ (unlock-buffer))
+ (set-buffer-modified-p nil)))
+ ;; Element (nil PROP VAL BEG . END) is property change.
+ (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+ (when (or (> (point-min) beg) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ (put-text-property beg end prop val))
+ ;; Element (BEG . END) means range was inserted.
+ (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+ ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
+ ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
+ (when (or (> (point-min) beg) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ ;; Set point first thing, so that undoing this undo
+ ;; does not send point back to where it is now.
+ (goto-char beg)
+ (delete-region beg end))
+ ;; Element (apply FUN . ARGS) means call FUN to undo.
+ (`(apply . ,fun-args)
+ (let ((currbuff (current-buffer)))
+ (if (integerp (car fun-args))
+ ;; Long format: (apply DELTA START END FUN . ARGS).
+ (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
+ (start-mark (copy-marker start nil))
+ (end-mark (copy-marker end t)))
+ (when (or (> (point-min) start) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ (apply fun args) ;; Use `save-current-buffer'?
+ ;; Check that the function did what the entry
+ ;; said it would do.
+ (unless (and (= start start-mark)
+ (= (+ delta end) end-mark))
+ (error "Changes to be undone by function different than announced"))
+ (set-marker start-mark nil)
+ (set-marker end-mark nil))
+ (apply fun-args))
+ (unless (eq currbuff (current-buffer))
+ (error "Undo function switched buffer"))
+ (setq did-apply t)))
+ ;; Element (STRING . POS) means STRING was deleted.
+ (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
+ (when (let ((apos (abs pos)))
+ (or (< apos (point-min)) (> apos (point-max))))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ (if (< pos 0)
+ (progn
+ (goto-char (- pos))
+ (insert string))
+ (goto-char pos)
+ ;; Now that we record marker adjustments
+ ;; (caused by deletion) for undo,
+ ;; we should always insert after markers,
+ ;; so that undoing the marker adjustments
+ ;; put the markers back in the right place.
+ (insert string)
+ (goto-char pos)))
+ ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
+ (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
+ (when (marker-buffer marker)
+ (set-marker marker
+ (- marker offset)
+ (marker-buffer marker))))
+ (_ (error "Unrecognized entry in undo list %S" next))))
+ (setq arg (1- arg)))
+ ;; Make sure an apply entry produces at least one undo entry,
+ ;; so the test in `undo' for continuing an undo series
+ ;; will work right.
+ (if (and did-apply
+ (eq oldlist buffer-undo-list))
+ (setq buffer-undo-list
+ (cons (list 'apply 'cdr nil) buffer-undo-list))))
+ list)
+
;; Deep copy of a list
(defun undo-copy-list (list)
"Make a copy of undo list LIST."
(or lc infile)
(if stderr-file (list (car buffer) stderr-file) buffer)
display args)
- (when stderr-file (copy-file stderr-file (cadr buffer)))))
+ (when stderr-file (copy-file stderr-file (cadr buffer) t))))
(when stderr-file (delete-file stderr-file))
(when lc (delete-file lc)))))
(kill-new string nil yank-handler)))
(when (or string (eq last-command 'kill-region))
(setq this-command 'kill-region))
+ (setq deactivate-mark t)
nil)
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
kill the rest of the current line, even if there are only
nonblanks there.
-If `kill-whole-line' is non-nil, then this command kills the whole line
+If option `kill-whole-line' is non-nil, then this command kills the whole line
including its terminating newline, when used at the beginning of a line
with no argument. As a consequence, you can always kill a whole line
by typing \\[move-beginning-of-line] \\[kill-line].
(when (mark t)
(setq mark-active t)
(unless transient-mark-mode
- (setq transient-mark-mode 'lambda))))
+ (setq transient-mark-mode 'lambda))
+ (run-hooks 'activate-mark-hook)))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
:type 'boolean
:group 'editing-basics)
-(defcustom set-mark-default-inactive nil
- "If non-nil, setting the mark does not activate it.
-This causes \\[set-mark-command] and \\[exchange-point-and-mark] to
-behave the same whether or not `transient-mark-mode' is enabled."
- :type 'boolean
- :group 'editing-basics
- :version "23.1")
-
(defun set-mark-command (arg)
"Set the mark where point is, or jump to the mark.
Setting the mark also alters the region, which is the text
(activate-mark)
(message "Mark activated")))
(t
- (push-mark-command nil)
- (if set-mark-default-inactive (deactivate-mark)))))
+ (push-mark-command nil))))
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
(deactivate-mark)
(set-mark (point))
(goto-char omark)
- (if set-mark-default-inactive (deactivate-mark))
(cond (temp-highlight
(setq transient-mark-mode (cons 'only transient-mark-mode)))
((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].
-Many commands change their behavior when Transient Mark mode is in effect
-and the mark is active, by acting on the region instead of their usual
-default part of the buffer's text. Examples of such commands include
-\\[comment-dwim], \\[flush-lines], \\[keep-lines], \
+Many commands change their behavior when Transient Mark mode is
+in effect and the mark is active, by acting on the region instead
+of their usual default part of the buffer's text. Examples of
+such commands include \\[comment-dwim], \\[flush-lines], \\[keep-lines],
\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
-Invoke \\[apropos-documentation] and type \"transient\" or
-\"mark.*active\" at the prompt, to see the documentation of
-commands which are sensitive to the Transient Mark mode."
+To see the documentation of commands which are sensitive to the
+Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\"
+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)
"Non-nil means vertical motion starting at end of line keeps to ends of lines.
This means moving to the end of each line moved onto.
The beginning of a blank line does not count as the end of a line.
-This has no effect when `line-move-visual' is non-nil."
+This has no effect when the variable `line-move-visual' is non-nil."
:type 'boolean
:group 'editing-basics)
(defcustom goal-column nil
"Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.
-A non-nil setting overrides `line-move-visual', which see."
+A non-nil setting overrides the variable `line-move-visual', which see."
:type '(choice integer
(const :tag "None" nil))
:group 'editing-basics)
It is the column where point was at the start of the current run
of vertical motion commands.
-When moving by visual lines via `line-move-visual', it is a cons
+When moving by visual lines via the function `line-move-visual', it is a cons
cell (COL . HSCROLL), where COL is the x-position, in pixels,
divided by the default column width, and HSCROLL is the number of
columns by which window is scrolled from left margin.
(unless (and auto-window-vscroll try-vscroll
;; Only vscroll for single line moves
(= (abs arg) 1)
+ ;; Under scroll-conservatively, the display engine
+ ;; does this better.
+ (zerop scroll-conservatively)
;; But don't vscroll in a keyboard macro.
(not defining-kbd-macro)
(not executing-kbd-macro)
(setq pos1 pos2 pos2 swap)))
(if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
(atomic-change-group
- (let (word2)
- ;; FIXME: We first delete the two pieces of text, so markers that
- ;; used to point to after the text end up pointing to before it :-(
- (setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
- (goto-char (car pos2))
- (insert (delete-and-extract-region (car pos1) (cdr pos1)))
- (goto-char (car pos1))
- (insert word2))))
+ ;; This sequence of insertions attempts to preserve marker
+ ;; positions at the start and end of the transposed objects.
+ (let* ((word (buffer-substring (car pos2) (cdr pos2)))
+ (len1 (- (cdr pos1) (car pos1)))
+ (len2 (length word))
+ (boundary (make-marker)))
+ (set-marker boundary (car pos2))
+ (goto-char (cdr pos1))
+ (insert-before-markers word)
+ (setq word (delete-and-extract-region (car pos1) (+ (car pos1) len1)))
+ (goto-char boundary)
+ (insert word)
+ (goto-char (+ boundary len1))
+ (delete-region (point) (+ (point) len2))
+ (set-marker boundary nil))))
\f
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
- (memq window-system '(ns))
+ (memq window-system '(w32 ns))
(and (memq window-system '(x))
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))