;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2014 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
-(defun newline (&optional arg)
+(defun newline (&optional arg interactive)
"Insert a newline, and move to left margin of the new line if it's blank.
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
-than the value of `fill-column' and ARG is nil."
- (interactive "*P")
+
+To turn off indentation by this command, disable Electric Indent mode
+\(see \\[electric-indent-mode]).
+
+Calls `auto-fill-function' if the current column number is greater
+than the value of `fill-column' and ARG is nil.
+A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
+ (interactive "*P\np")
(barf-if-buffer-read-only)
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
;; Set last-command-event to tell self-insert what to insert.
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (unwind-protect
- (progn
- (add-hook 'post-self-insert-hook postproc)
+ (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.
+ (let ((post-self-insert-hook (list postproc)))
(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)))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc)
+ (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))))
nil)
(defun set-hard-newline-properties (from to)
column specified by the function `current-left-margin'."
(interactive "*")
(delete-horizontal-space t)
- (newline)
+ (newline 1 t)
(indent-according-to-mode))
(defun reindent-then-newline-and-indent ()
(delete-horizontal-space t))
(indent-according-to-mode)))
+(defcustom read-quoted-char-radix 8
+ "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+Legitimate radix values are 8, 10 and 16."
+ :type '(choice (const 8) (const 10) (const 16))
+ :group 'editing-basics)
+
+(defun read-quoted-char (&optional prompt)
+ "Like `read-char', but do not allow quitting.
+Also, if the first character read is an octal digit,
+we read any number of octal digits and return the
+specified character code. Any nondigit terminates the sequence.
+If the terminator is RET, it is discarded;
+any other terminator is used itself as input.
+
+The optional argument PROMPT specifies a string to use to prompt the user.
+The variable `read-quoted-char-radix' controls which radix to use
+for numeric input."
+ (let ((message-log-max nil) done (first t) (code 0) translated)
+ (while (not done)
+ (let ((inhibit-quit first)
+ ;; Don't let C-h get the help message--only help function keys.
+ (help-char nil)
+ (help-form
+ "Type the special character you want to use,
+or the octal character code.
+RET terminates the character code and is discarded;
+any other non-digit terminates the character code and is then used as input."))
+ (setq translated (read-key (and prompt (format "%s-" prompt))))
+ (if inhibit-quit (setq quit-flag nil)))
+ (if (integerp translated)
+ (setq translated (char-resolve-modifiers translated)))
+ (cond ((null translated))
+ ((not (integerp translated))
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))
+ done t))
+ ((/= (logand translated ?\M-\^@) 0)
+ ;; Turn a meta-character into a character with the 0200 bit set.
+ (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
+ done t))
+ ((and (<= ?0 translated)
+ (< translated (+ ?0 (min 10 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (<= ?a (downcase translated))
+ (< (downcase translated)
+ (+ ?a -10 (min 36 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix)
+ (+ 10 (- (downcase translated) ?a))))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (not first) (eq translated ?\C-m))
+ (setq done t))
+ ((not first)
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))
+ done t))
+ (t (setq code translated
+ done t)))
+ (setq first nil))
+ code))
+
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
(point-min))))
(if (and arg (not (consp arg))) (forward-line 1)))
+(put 'beginning-of-buffer 'interactive-only
+ "use `(goto-char (point-min))' instead.")
(defun end-of-buffer (&optional arg)
"Move point to the end of the buffer.
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
(recenter -3))))
+(put 'end-of-buffer 'interactive-only "use `(goto-char (point-max))' instead.")
(defcustom delete-active-region t
"Whether single-char deletion commands delete an active region.
:group 'killing
:version "24.1")
+(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))))
+ "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.")
+
(defun delete-backward-char (n &optional killflag)
"Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
- (kill-region (region-beginning) (region-end))
- (delete-region (region-beginning) (region-end))))
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
;; In Overwrite mode, maybe untabify while deleting
((null (or (null overwrite-mode)
(<= n 0)
(insert-char ?\s (- ocol (current-column)) nil))))
;; Otherwise, do simple deletion.
(t (delete-char (- n) killflag))))
+(put 'delete-backward-char 'interactive-only 'delete-char)
(defun delete-forward-char (n &optional killflag)
"Delete the following N characters (previous if N is negative).
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
- (kill-region (region-beginning) (region-end))
- (delete-region (region-beginning) (region-end))))
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
+
;; Otherwise, do simple deletion.
(t (delete-char n killflag))))
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
+(put 'goto-line 'interactive-only 'forward-line)
(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
Such arguments are used as in `read-from-minibuffer'.)"
;; Used for interactive spec `x'.
(read-from-minibuffer prompt initial-contents minibuffer-local-map
- t minibuffer-history))
+ t 'minibuffer-history))
(defun eval-minibuffer (prompt &optional initial-contents)
"Return value of Lisp expression read using the minibuffer.
in addition to the value printed by prin1 in functions which
display the result of expression evaluation."
(if (and (integerp value)
- (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (eq this-command last-command)
- (if (boundp 'edebug-active) edebug-active)))
+ (or (eq standard-output t)
+ (zerop (prefix-numeric-value current-prefix-arg))))
(let ((char-string
- (if (or (if (boundp 'edebug-active) edebug-active)
- (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (prin1-char value))))
+ (if (and (characterp value)
+ (char-displayable-p value))
+ (prin1-char value))))
(if char-string
(format " (#o%o, #x%x, %s)" value value char-string)
(format " (#o%o, #x%x)" value value)))))
Value is also consed on to front of the variable `values'.
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'
+instead of printing it in the echo area. With a zero prefix arg,
+insert the result with no limit on the length and level of lists,
+and include additional formats for integers (octal, hexadecimal,
+and character). Truncates long output according to the value
+of the variables `eval-expression-print-length'
and `eval-expression-print-level'.
If `eval-expression-debug-on-error' is non-nil, which is the default,
(unless (eq old-value new-value)
(setq debug-on-error new-value))))
- (let ((print-length eval-expression-print-length)
- (print-level eval-expression-print-level)
+ (let ((print-length (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-length))
+ (print-level (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-level))
(deactivate-mark))
(if insert-value
(with-no-warnings
(let ((standard-output (current-buffer)))
- (prin1 (car values))))
+ (prog1
+ (prin1 (car values))
+ (when (zerop (prefix-numeric-value insert-value))
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str)))))))
(prog1
(prin1 (car values) t)
(let ((str (eval-expression-print-format (car values))))
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
+You can configure `async-shell-command-buffer' to specify what to do in
+case when `*Async Shell Command*' buffer is already taken by another
+running shell command. To run COMMAND without displaying the output
+in a window you can configure `display-buffer-alist' to use the action
+`display-buffer-no-window' for the buffer `*Async Shell Command*'.
+
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of a
shell (with its need to quote arguments)."
;; which comint sometimes adds for prompts.
(let ((inhibit-read-only t))
(erase-buffer))
- (display-buffer buffer)
+ (display-buffer buffer '(nil (allow-no-window . t)))
(setq default-directory directory)
(setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
nil)
\f
(defvar universal-argument-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'universal-argument-other-key)
- (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
- (define-key map [switch-frame] nil)
+ (let ((map (make-sparse-keymap))
+ (universal-argument-minus
+ ;; For backward compatibility, minus with no modifiers is an ordinary
+ ;; command if digits have already been entered.
+ `(menu-item "" negative-argument
+ :filter ,(lambda (cmd)
+ (if (integerp prefix-arg) nil cmd)))))
+ (define-key map [switch-frame]
+ (lambda (e) (interactive "e")
+ (handle-switch-frame e) (universal-argument--mode)))
(define-key map [?\C-u] 'universal-argument-more)
- (define-key map [?-] 'universal-argument-minus)
+ (define-key map [?-] universal-argument-minus)
(define-key map [?0] 'digit-argument)
(define-key map [?1] 'digit-argument)
(define-key map [?2] 'digit-argument)
(define-key map [kp-7] 'digit-argument)
(define-key map [kp-8] 'digit-argument)
(define-key map [kp-9] 'digit-argument)
- (define-key map [kp-subtract] 'universal-argument-minus)
+ (define-key map [kp-subtract] universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
-(defvar universal-argument-num-events nil
- "Number of argument-specifying events read by `universal-argument'.
-`universal-argument-other-key' uses this to discard those events
-from (this-command-keys), and reread only the final command.")
-
-(defvar saved-overriding-map t
- "The saved value of `overriding-terminal-local-map'.
-That variable gets restored to this value on exiting \"universal
-argument mode\".")
-
-(defun save&set-overriding-map (map)
- "Set `overriding-terminal-local-map' to MAP."
- (when (eq saved-overriding-map t)
- (setq saved-overriding-map overriding-terminal-local-map)
- (setq overriding-terminal-local-map map)))
-
-(defun restore-overriding-map ()
- "Restore `overriding-terminal-local-map' to its saved value."
- (setq overriding-terminal-local-map saved-overriding-map)
- (setq saved-overriding-map t))
+(defun universal-argument--mode ()
+ (set-transient-map universal-argument-map))
(defun universal-argument ()
"Begin a numeric argument for the following command.
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (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.
(defun universal-argument-more (arg)
+ ;; 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")
- (if (consp arg)
- (setq prefix-arg (list (* 4 (car arg))))
- (if (eq arg '-)
- (setq prefix-arg (list -4))
- (setq prefix-arg arg)
- (restore-overriding-map)))
- (setq universal-argument-num-events (length (this-command-keys))))
+ (setq prefix-arg (if (consp arg)
+ (list (* 4 (car arg)))
+ (if (eq arg '-)
+ (list -4)
+ arg)))
+ (when (consp prefix-arg) (universal-argument--mode)))
(defun negative-argument (arg)
"Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (cond ((integerp arg)
- (setq prefix-arg (- arg)))
- ((eq arg '-)
- (setq prefix-arg nil))
- (t
- (setq prefix-arg '-)))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (setq prefix-arg (cond ((integerp arg) (- arg))
+ ((eq arg '-) nil)
+ (t '-)))
+ (universal-argument--mode))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
last-command-event
(get last-command-event 'ascii-character)))
(digit (- (logand char ?\177) ?0)))
- (cond ((integerp arg)
- (setq prefix-arg (+ (* arg 10)
- (if (< arg 0) (- digit) digit))))
- ((eq arg '-)
- ;; Treat -0 as just -, so that -01 will work.
- (setq prefix-arg (if (zerop digit) '- (- digit))))
- (t
- (setq prefix-arg digit))))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
-
-;; For backward compatibility, minus with no modifiers is an ordinary
-;; command if digits have already been entered.
-(defun universal-argument-minus (arg)
- (interactive "P")
- (if (integerp arg)
- (universal-argument-other-key arg)
- (negative-argument arg)))
-
-;; Anything else terminates the argument and is left in the queue to be
-;; executed as a command.
-(defun universal-argument-other-key (arg)
- (interactive "P")
- (setq prefix-arg arg)
- (let* ((key (this-command-keys))
- (keylist (listify-key-sequence key)))
- (setq unread-command-events
- (append (nthcdr universal-argument-num-events keylist)
- unread-command-events)))
- (reset-this-command-lengths)
- (restore-overriding-map))
+ (setq prefix-arg (cond ((integerp arg)
+ (+ (* arg 10)
+ (if (< arg 0) (- digit) digit)))
+ ((eq arg '-)
+ ;; Treat -0 as just -, so that -01 will work.
+ (if (zerop digit) '- (- digit)))
+ (t
+ digit))))
+ (universal-argument--mode))
\f
(defvar filter-buffer-substring-functions nil
:group 'killing
:version "23.2")
-(defun kill-new (string &optional replace yank-handler)
+(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
- (if (> (length string) 0)
- (if yank-handler
- (put-text-property 0 (length string)
- 'yank-handler yank-handler string))
- (if yank-handler
- (signal 'args-out-of-range
- (list string "yank-handler specified for empty string"))))
(unless (and kill-do-not-save-duplicates
;; Due to text properties such as 'yank-handler that
;; can alter the contents to yank, comparison using
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string)))
-(set-advertised-calling-convention
- 'kill-new '(string &optional replace) "23.3")
-(defun kill-append (string before-p &optional yank-handler)
+(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.
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 yank-handler (get-text-property 0 'yank-handler cur)))
- yank-handler)))
-(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
+ (equal nil (get-text-property 0 'yank-handler cur))))))
(defcustom yank-pop-change-selection nil
"Whether rotating the kill ring changes the window system selection.
:type 'boolean
:group 'killing)
-(defun kill-region (beg end &optional yank-handler)
+(defun kill-region (beg end &optional region)
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
The command \\[yank] can retrieve it from there.
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."
- ;; Pass point first, then mark, because the order matters
- ;; when calling kill-append.
- (interactive (list (point) (mark)))
+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."
+ ;; 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"))
(condition-case nil
- (let ((string (filter-buffer-substring beg end t)))
+ (let ((string (if region
+ (funcall region-extract-function 'delete)
+ (filter-buffer-substring beg end 'delete))))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
- (kill-append string (< end beg) yank-handler)
- (kill-new string nil yank-handler)))
+ (kill-append string (< end beg))
+ (kill-new string nil)))
(when (or string (eq last-command 'kill-region))
(setq this-command 'kill-region))
(setq deactivate-mark t)
;; We should beep, in case the user just isn't aware of this.
;; However, there's no harm in putting
;; the region's text in the kill ring, anyway.
- (copy-region-as-kill beg end)
+ (copy-region-as-kill beg end region)
;; Set this-command now, so it will be set even if we get an error.
(setq this-command 'kill-region)
;; This should barf, if appropriate, and give us the correct error.
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
(signal 'text-read-only (list (current-buffer)))))))
-(set-advertised-calling-convention 'kill-region '(beg end) "23.3")
;; copy-region-as-kill no longer sets this-command, because it's confusing
;; to get two copies of the text when the user accidentally types M-w and
;; then corrects it with the intended C-w.
-(defun copy-region-as-kill (beg end)
+(defun copy-region-as-kill (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
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.
+
This command's old key binding has been given to `kill-ring-save'."
- (interactive "r")
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (let ((str (if region
+ (funcall region-extract-function nil)
+ (filter-buffer-substring beg end))))
(if (eq last-command 'kill-region)
- (kill-append (filter-buffer-substring beg end) (< end beg))
- (kill-new (filter-buffer-substring beg end)))
+ (kill-append str (< end beg))
+ (kill-new str)))
(setq deactivate-mark t)
nil)
-(defun kill-ring-save (beg end)
+(defun kill-ring-save (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
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.
+
This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
- (interactive "r")
- (copy-region-as-kill beg end)
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (copy-region-as-kill beg end region)
;; This use of called-interactively-p is correct because the code it
;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
(buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
- "Cause following command, if it kills, to append to previous kill.
+ "Cause following command, if it kills, to add to previous kill.
+If the next command kills forward from point, the kill is
+appended to the previous killed text. If the command kills
+backward, the kill is prepended. Kill commands that act on the
+region, such as `kill-region', are regarded as killing forward if
+point is after mark, and killing backward if point is before
+mark.
+
+If the next command is not a kill command, `append-next-kill' has
+no effect.
+
The argument is used for internal purposes; do not supply one."
(interactive "p")
;; We don't use (interactive-p), since that breaks kbd macros.
This is done prior to removing the properties specified by
`yank-excluded-properties'."
:group 'killing
+ :type '(repeat (cons (symbol :tag "property symbol")
+ function))
:version "24.3")
;; This is actually used in subr.el but defcustom does not work there.
(insert-buffer-substring (get-buffer buffer))
(point)))
nil)
+(put 'insert-buffer 'interactive-only 'insert-buffer-substring)
(defun append-to-buffer (buffer start end)
"Append to specified buffer the text of the region.
(marker-position (mark-marker))
(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.
If Transient Mark mode is disabled, this function normally does
(or (x-selection-owner-p 'PRIMARY)
(null (x-selection-exists-p 'PRIMARY))))
(x-set-selection 'PRIMARY
- (buffer-substring (region-beginning)
- (region-end))))))
+ (funcall region-extract-function nil)))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
also checks the value of `use-empty-active-region'."
(and transient-mark-mode mark-active))
-(defvar mark-ring nil
+
+(defvar redisplay-unhighlight-region-function
+ (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
+
+(defvar redisplay-highlight-region-function
+ (lambda (start end window rol)
+ (if (not (overlayp rol))
+ (let ((nrol (make-overlay start end)))
+ (funcall redisplay-unhighlight-region-function rol)
+ (overlay-put nrol 'window window)
+ (overlay-put nrol 'face 'region)
+ nrol)
+ (unless (and (eq (overlay-buffer rol) (current-buffer))
+ (eq (overlay-start rol) start)
+ (eq (overlay-end rol) end))
+ (move-overlay rol start end (current-buffer)))
+ 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"
+ (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)))))))))
+
+(add-function :before pre-redisplay-function
+ #'redisplay--update-region-highlights)
+
+
+(defvar-local mark-ring nil
"The list of former marks of the current buffer, most recent first.")
-(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
(defcustom mark-ring-max 16
(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
(if (null omark)
(error "No mark set in this buffer"))
- (deactivate-mark)
(set-mark (point))
(goto-char omark)
(cond (temp-highlight
(signal (car err) (cdr err))))
(line-move arg nil nil try-vscroll)))
nil)
+(put 'next-line 'interactive-only 'forward-line)
(defun previous-line (&optional arg try-vscroll)
"Move cursor vertically up ARG lines.
(signal (car err) (cdr err))))
(line-move (- arg) nil nil try-vscroll))
nil)
+(put 'previous-line 'interactive-only
+ "use `forward-line' with negative argument instead.")
(defcustom track-eol nil
"Non-nil means vertical motion starting at end of line keeps to ends of lines.
:group 'editing-basics
:version "23.1")
+;; Only used if display-graphic-p.
+(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."
(let ((default-font (face-font 'default)))
;; When the text in the window is scrolled to the left,
;; display-based motion doesn't make sense (because each
;; logical line occupies exactly one screen line).
- (not (> (window-hscroll) 0)))
+ (not (> (window-hscroll) 0))
+ ;; Likewise when the text _was_ scrolled to the left
+ ;; when the current run of vertical motion commands
+ ;; started.
+ (not (and (memq last-command
+ `(next-line previous-line ,this-command))
+ auto-hscroll-mode
+ (numberp temporary-goal-column)
+ (>= temporary-goal-column
+ (- (window-width) hscroll-margin)))))
(prog1 (line-move-visual arg noerror)
;; If we moved into a tall line, set vscroll to make
;; scrolling through tall images more smooth.
START can be nil, if it was not found.
The function should return non-nil if the two tokens do not match.")
+(defvar blink-matching--overlay
+ (let ((ol (make-overlay (point) (point) nil t)))
+ (overlay-put ol 'face 'show-paren-match)
+ (delete-overlay ol)
+ ol)
+ "Overlay used to highlight the matching paren.")
+
(defun blink-matching-open ()
- "Move cursor momentarily to the beginning of the sexp before point."
+ "Momentarily highlight the beginning of the sexp before point."
(interactive)
(when (and (not (bobp))
blink-matching-paren)
(message "No matching parenthesis found"))))
((not blinkpos) nil)
((pos-visible-in-window-p blinkpos)
- ;; Matching open within window, temporarily move to blinkpos but only
- ;; if `blink-matching-paren-on-screen' is non-nil.
+ ;; Matching open within window, temporarily 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)
- (save-excursion
- (goto-char blinkpos)
- (sit-for blink-matching-delay))))
+ (unwind-protect
+ (progn
+ (move-overlay blink-matching--overlay blinkpos (1+ blinkpos)
+ (current-buffer))
+ (sit-for blink-matching-delay))
+ (delete-overlay blink-matching--overlay))))
(t
(save-excursion
(goto-char blinkpos)
(point))))))
(funcall blink-paren-function)))
+(put 'blink-paren-post-self-insert-function 'priority 100)
+
(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
;; Most likely, this hook is nil, so this arg doesn't matter,
;; but I use it as a reminder that this function usually
- ;; likes to be run after others since it does `sit-for'.
+ ;; likes to be run after others since it does
+ ;; `sit-for'. That's also the reason it get a `priority' prop
+ ;; of 100.
'append)
\f
;; This executes C-g typed while Emacs is waiting for a command.
(normal (nth 1 keypad-normal)))
(put keypad 'ascii-character normal)
(define-key function-key-map (vector keypad) (vector normal))))
- '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
- (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
- (kp-space ?\s)
+ ;; See also kp-keys bound in bindings.el.
+ '((kp-space ?\s)
(kp-tab ?\t)
(kp-enter ?\r)
- (kp-multiply ?*)
- (kp-add ?+)
(kp-separator ?,)
- (kp-subtract ?-)
- (kp-decimal ?.)
- (kp-divide ?/)
(kp-equal ?=)
;; Do the same for various keys that are represented as symbols under
;; GUIs but naturally correspond to characters.
(if enabled
(progn
(define-key local-function-key-map [delete] [deletechar])
- (define-key local-function-key-map [kp-delete] [?\C-d])
+ (define-key local-function-key-map [kp-delete] [deletechar])
(define-key local-function-key-map [backspace] [?\C-?])
(dolist (b bindings)
;; Not sure if input-decode-map is really right, but
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
\f
+(defvar messages-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map "g" nil) ; nothing to revert
+ map))
+
+(define-derived-mode messages-buffer-mode special-mode "Messages"
+ "Major mode used in the \"*Messages*\" buffer.")
+
+(defun messages-buffer ()
+ "Return the \"*Messages*\" buffer.
+If it does not exist, create and it switch it to `messages-buffer-mode'."
+ (or (get-buffer "*Messages*")
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (messages-buffer-mode)
+ (current-buffer))))
+
+\f
;; Minibuffer prompt stuff.
;;(defun minibuffer-prompt-modification (start end)