;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
-;; 2000, 2001, 2002, 2003
+;; 2000, 01, 02, 03, 04
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(defgroup killing nil
- "Killing and yanking commands"
+ "Killing and yanking commands."
:group 'editing)
(defgroup paren-matching nil
(setq found buffer)))
(setq list (cdr list)))
(switch-to-buffer found)))
+\f
+;;; next-error support framework
+(defvar next-error-last-buffer nil
+ "The most recent next-error buffer.
+A buffer becomes most recent when its compilation, grep, or
+similar mode is started, or when it is used with \\[next-error]
+or \\[compile-goto-error].")
+
+(defvar next-error-function nil
+ "Function to use to find the next error in the current buffer.
+The function is called with 2 parameters:
+ARG is an integer specifying by how many errors to move.
+RESET is a boolean which, if non-nil, says to go back to the beginning
+of the errors before moving.
+Major modes providing compile-like functionality should set this variable
+to indicate to `next-error' that this is a candidate buffer and how
+to navigate in it.")
+
+(make-variable-buffer-local 'next-error-function)
+
+(defsubst next-error-buffer-p (buffer &optional extra-test)
+ "Test if BUFFER is a next-error capable buffer."
+ (with-current-buffer buffer
+ (or (and extra-test (funcall extra-test))
+ next-error-function)))
+
+(defun next-error-find-buffer (&optional other-buffer extra-test)
+ "Return a next-error capable buffer."
+ (or
+ ;; 1. If one window on the selected frame displays such buffer, return it.
+ (let ((window-buffers
+ (delete-dups
+ (delq nil (mapcar (lambda (w)
+ (if (next-error-buffer-p
+ (window-buffer w) extra-test)
+ (window-buffer w)))
+ (window-list))))))
+ (if other-buffer
+ (setq window-buffers (delq (current-buffer) window-buffers)))
+ (if (eq (length window-buffers) 1)
+ (car window-buffers)))
+ ;; 2. If next-error-last-buffer is set to a live buffer, use that.
+ (if (and next-error-last-buffer
+ (buffer-name next-error-last-buffer)
+ (next-error-buffer-p next-error-last-buffer extra-test)
+ (or (not other-buffer)
+ (not (eq next-error-last-buffer (current-buffer)))))
+ next-error-last-buffer)
+ ;; 3. If the current buffer is a next-error capable buffer, return it.
+ (if (and (not other-buffer)
+ (next-error-buffer-p (current-buffer) extra-test))
+ (current-buffer))
+ ;; 4. Look for a next-error capable buffer in a buffer list.
+ (let ((buffers (buffer-list)))
+ (while (and buffers
+ (or (not (next-error-buffer-p (car buffers) extra-test))
+ (and other-buffer (eq (car buffers) (current-buffer)))))
+ (setq buffers (cdr buffers)))
+ (if buffers
+ (car buffers)
+ (or (and other-buffer
+ (next-error-buffer-p (current-buffer) extra-test)
+ ;; The current buffer is a next-error capable buffer.
+ (progn
+ (if other-buffer
+ (message "This is the only next-error capable buffer"))
+ (current-buffer)))
+ (error "No next-error capable buffer found"))))))
+
+(defun next-error (&optional arg reset)
+ "Visit next next-error message and corresponding source code.
+
+If all the error messages parsed so far have been processed already,
+the message buffer is checked for new ones.
+
+A prefix ARG specifies how many error messages to move;
+negative means move back to previous error messages.
+Just \\[universal-argument] as a prefix means reparse the error message buffer
+and start at the first error.
+
+The RESET argument specifies that we should restart from the beginning.
+
+\\[next-error] normally uses the most recently started
+compilation, grep, or occur buffer. It can also operate on any
+buffer with output from the \\[compile], \\[grep] commands, or,
+more generally, on any buffer in Compilation mode or with
+Compilation Minor mode enabled, or any buffer in which
+`next-error-function' is bound to an appropriate function.
+To specify use of a particular buffer for error messages, type
+\\[next-error] in that buffer when it is the only one displayed
+in the current frame.
+
+Once \\[next-error] has chosen the buffer for error messages,
+it stays with that buffer until you use it in some other buffer which
+uses Compilation mode or Compilation Minor mode.
+
+See variables `compilation-parse-errors-function' and
+\`compilation-error-regexp-alist' for customization ideas."
+ (interactive "P")
+ (if (consp arg) (setq reset t arg nil))
+ (when (setq next-error-last-buffer (next-error-find-buffer))
+ ;; we know here that next-error-function is a valid symbol we can funcall
+ (with-current-buffer next-error-last-buffer
+ (funcall next-error-function (prefix-numeric-value arg) reset))))
+
+(defalias 'goto-next-locus 'next-error)
+(defalias 'next-match 'next-error)
+
+(define-key ctl-x-map "`" 'next-error)
+
+(defun previous-error (&optional n)
+ "Visit previous next-error message and corresponding source code.
+
+Prefix arg N says how many error messages to move backwards (or
+forwards, if negative).
+
+This operates on the output from the \\[compile] and \\[grep] commands."
+ (interactive "p")
+ (next-error (- (or n 1))))
+
+(defun first-error (&optional n)
+ "Restart at the first error.
+Visit corresponding source code.
+With prefix arg N, visit the source code of the Nth error.
+This operates on the output from the \\[compile] command, for instance."
+ (interactive "p")
+ (next-error n t))
+
+(defun next-error-no-select (&optional n)
+ "Move point to the next error in the next-error buffer and highlight match.
+Prefix arg N says how many error messages to move forwards (or
+backwards, if negative).
+Finds and highlights the source line like \\[next-error], but does not
+select the source buffer."
+ (interactive "p")
+ (let ((next-error-highlight next-error-highlight-no-select))
+ (next-error n))
+ (pop-to-buffer next-error-last-buffer))
+
+(defun previous-error-no-select (&optional n)
+ "Move point to the previous error in the next-error buffer and highlight match.
+Prefix arg N says how many error messages to move backwards (or
+forwards, if negative).
+Finds and highlights the source line like \\[previous-error], but does not
+select the source buffer."
+ (interactive "p")
+ (next-error-no-select (- (or n 1))))
+
+(defgroup next-error nil
+ "next-error support framework."
+ :group 'compilation
+ :version "21.4")
+
+(defface next-error
+ '((t (:inherit region)))
+ "Face used to highlight next error locus."
+ :group 'next-error
+ :version "21.4")
+
+(defcustom next-error-highlight 0.1
+ "*Highlighting of locations in selected source buffers.
+If number, highlight the locus in next-error face for given time in seconds.
+If t, use persistent overlays fontified in next-error face.
+If nil, don't highlight the locus in the source buffer.
+If `fringe-arrow', indicate the locus by the fringe arrow."
+ :type '(choice (number :tag "Delay")
+ (const :tag "Persistent overlay" t)
+ (const :tag "No highlighting" nil)
+ (const :tag "Fringe arrow" 'fringe-arrow))
+ :group 'next-error
+ :version "21.4")
+
+(defcustom next-error-highlight-no-select 0.1
+ "*Highlighting of locations in non-selected source buffers.
+If number, highlight the locus in next-error face for given time in seconds.
+If t, use persistent overlays fontified in next-error face.
+If nil, don't highlight the locus in the source buffer.
+If `fringe-arrow', indicate the locus by the fringe arrow."
+ :type '(choice (number :tag "Delay")
+ (const :tag "Persistent overlay" t)
+ (const :tag "No highlighting" nil)
+ (const :tag "Fringe arrow" 'fringe-arrow))
+ :group 'next-error
+ :version "21.4")
+
+;;; Internal variable for `next-error-follow-mode-post-command-hook'.
+(defvar next-error-follow-last-line nil)
+
+(define-minor-mode next-error-follow-minor-mode
+ "Minor mode for compilation, occur and diff modes.
+When turned on, cursor motion in the compilation, grep, occur or diff
+buffer causes automatic display of the corresponding source code
+location."
+ nil " Fol" nil
+ (if (not next-error-follow-minor-mode)
+ (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
+ (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
+ (make-variable-buffer-local 'next-error-follow-last-line)))
+
+;;; Used as a `post-command-hook' by `next-error-follow-mode'
+;;; for the *Compilation* *grep* and *Occur* buffers.
+(defun next-error-follow-mode-post-command-hook ()
+ (unless (equal next-error-follow-last-line (line-number-at-pos))
+ (setq next-error-follow-last-line (line-number-at-pos))
+ (condition-case nil
+ (let ((compilation-context-lines nil))
+ (setq compilation-current-error (point))
+ (next-error-no-select 0))
+ (error t))))
+
+\f
+;;;
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
(interactive)
- (kill-all-local-variables))
+ (kill-all-local-variables)
+ (run-hooks 'after-change-major-mode-hook))
;; Making and deleting lines.
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
-(defun open-line (arg)
+(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.
(loc (point))
;; Don't expand an abbrev before point.
(abbrev-mode nil))
- (newline arg)
+ (newline n)
(goto-char loc)
- (while (> arg 0)
+ (while (> n 0)
(cond ((bolp)
(if do-left-margin (indent-to (current-left-margin)))
(if do-fill-prefix (insert-and-inherit fill-prefix))))
(forward-line 1)
- (setq arg (1- arg)))
+ (setq n (1- n)))
(goto-char loc)
(end-of-line)))
(defun split-line (&optional arg)
"Split current line, moving portion beyond point vertically down.
If the current line starts with `fill-prefix', insert it on the new
-line as well. With prefix arg, don't insert fill-prefix on new line.
+line as well. With prefix ARG, don't insert fill-prefix on new line.
-When called from Lisp code, the arg may be a prefix string to copy."
+When called from Lisp code, ARG may be a prefix string to copy."
(interactive "*P")
(skip-chars-forward " \t")
(let* ((col (current-column))
In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (delete-horizontal-space t)
(let ((pos (point)))
;; Be careful to insert the newline before indenting the line.
;; Otherwise, the indentation might be wrong.
(newline)
(save-excursion
(goto-char pos)
- (indent-according-to-mode))
+ (indent-according-to-mode)
+ (delete-horizontal-space t))
(indent-according-to-mode)))
(defun quoted-insert (arg)
(insert-and-inherit char)
(setq arg (1- arg)))))
-(defun forward-to-indentation (arg)
+(defun forward-to-indentation (&optional arg)
"Move forward ARG lines and position at first nonblank character."
(interactive "p")
- (forward-line arg)
+ (forward-line (or arg 1))
(skip-chars-forward " \t"))
-(defun backward-to-indentation (arg)
+(defun backward-to-indentation (&optional arg)
"Move backward ARG lines and position at first nonblank character."
(interactive "p")
- (forward-line (- arg))
+ (forward-line (- (or arg 1)))
(skip-chars-forward " \t"))
(defun back-to-indentation ()
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
\f
+(defvar inhibit-mark-movement nil
+ "If non-nil, \\[beginning-of-buffer] and \\[end-of-buffer] does not set the mark.")
+
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the beginning.
+With \\[universal-argument] prefix, do not set mark at previous position.
+With numeric arg N, put point N/10 of the way from the beginning.
If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
(interactive "P")
- (push-mark)
+ (unless (or inhibit-mark-movement (consp arg))
+ (push-mark))
(let ((size (- (point-max) (point-min))))
- (goto-char (if arg
+ (goto-char (if (and arg (not (consp arg)))
(+ (point-min)
(if (> size 10000)
;; Avoid overflow for large buffer sizes!
(defun end-of-buffer (&optional arg)
"Move point to the end of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the end.
+With \\[universal-argument] prefix, do not set mark at previous position.
+With numeric arg N, put point N/10 of the way from the end.
If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
(interactive "P")
- (push-mark)
+ (unless (or inhibit-mark-movement (consp arg))
+ (push-mark))
(let ((size (- (point-max) (point-min))))
- (goto-char (if arg
+ (goto-char (if (and arg (not (consp arg)))
(- (point-max)
(if (> size 10000)
;; Avoid overflow for large buffer sizes!
(defun what-line ()
"Print the current buffer line number and narrowed line number of point."
(interactive)
- (let ((opoint (point)) start)
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (widen)
- (forward-line 0)
- (setq start (point))
- (goto-char opoint)
- (forward-line 0)
- (if (/= start (point-min))
- (message "line %d (narrowed line %d)"
- (1+ (count-lines (point-min) (point)))
- (1+ (count-lines start (point))))
- (message "Line %d" (1+ (count-lines (point-min) (point)))))))))
+ (let ((opoint (point)) (start (point-min))
+ (n (line-number-at-pos)))
+ (if (= start 1)
+ (message "Line %d" n)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (message "line %d (narrowed line %d)"
+ (+ n (line-number-at-pos start) -1) n))))))
(defun count-lines (start end)
"Return number of lines between START and END.
done)))
(- (buffer-size) (forward-line (buffer-size)))))))
+(defun line-number-at-pos (&optional pos)
+ "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location."
+ (let ((opoint (or pos (point))) start)
+ (save-excursion
+ (goto-char (point-min))
+ (setq start (point))
+ (goto-char opoint)
+ (forward-line 0)
+ (1+ (count-lines start (point))))))
+
(defun what-cursor-position (&optional detail)
"Print info on cursor position (on screen and within buffer).
Also describe the character after point, and give its character code
(if (or (not coding)
(eq (coding-system-type coding) t))
(setq coding default-buffer-file-coding-system))
- (if (not (char-valid-p char))
+ (if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
- (format "(0%o, %d, 0x%x, invalid)" char char char))
+ (format "(0%o, %d, 0x%x, raw-byte)" char char char))
(setq encoded (and (>= char 128) (encode-coding-char char coding)))
(setq encoding-msg
(if encoded
:type 'boolean
:version "21.1")
+(defun eval-expression-print-format (value)
+ "Format VALUE as a result of evaluated expression.
+Return a formatted string which is displayed in the echo area
+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)
+ (and (boundp 'edebug-active) edebug-active)))
+ (let ((char-string
+ (if (or (and (boundp 'edebug-active) edebug-active)
+ (memq this-command '(eval-last-sexp eval-print-last-sexp)))
+ (prin1-char value))))
+ (if char-string
+ (format " (0%o, 0x%x) = %s" value value char-string)
+ (format " (0%o, 0x%x)" value value)))))
+
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (eval-expression-arg
(let ((print-length eval-expression-print-length)
(print-level eval-expression-print-level))
- (prin1 (car values)
- (if eval-expression-insert-value (current-buffer) t))))
+ (if eval-expression-insert-value
+ (with-no-warnings
+ (let ((standard-output (current-buffer)))
+ (eval-last-sexp-print-value (car values))))
+ (prog1
+ (prin1 (car values) t)
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str t)))))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
(let ((command
- (unwind-protect
- (read-from-minibuffer prompt
- (prin1-to-string command)
- read-expression-map t
- '(command-history . 1))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history))))))
+ (let ((print-level nil)
+ (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
+ (unwind-protect
+ (read-from-minibuffer prompt
+ (prin1-to-string command)
+ read-expression-map t
+ 'command-history)
+ ;; If command was added to command-history as a string,
+ ;; get rid of that. We want only evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history)))))))
;; If command to be redone does not match front of history,
;; add it to the history.
This is used for all minibuffer input
except when an alternate history list is specified.")
(defvar minibuffer-history-sexp-flag nil
- "Non-nil when doing history operations on the variable `command-history'.
-More generally, indicates that the history list being acted on
-contains expressions rather than strings.
-It is only valid if its value equals the current minibuffer depth,
-to handle recursive uses of the minibuffer.")
+ "Control whether history list elements are expressions or strings.
+If the value of this variable equals current minibuffer depth,
+they are expressions; otherwise they are strings.
+\(That convention is designed to do the right thing fora
+recursive uses of the minibuffer.)")
(setq minibuffer-history-variable 'minibuffer-history)
(setq minibuffer-history-position nil)
(defvar minibuffer-history-search-history nil)
nil
minibuffer-local-map
nil
- 'minibuffer-history-search-history)))
+ 'minibuffer-history-search-history
+ (car minibuffer-history-search-history))))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
(if minibuffer-history-search-history
;; another undo command will find the undo history empty
;; and will get another error. To begin undoing the undos,
;; you must type some other command.
- (setq this-command 'undo)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
+ ;; If we get an error in undo-start,
+ ;; the next command should not be a "consecutive undo".
+ ;; So set `this-command' to something other than `undo'.
+ (setq this-command 'undo-start)
+
(unless (eq last-command 'undo)
(setq undo-in-region
(if transient-mark-mode mark-active (and arg (not (numberp arg)))))
(undo-start))
;; get rid of initial undo boundary
(undo-more 1))
+ ;; If we got this far, the next command should be a consecutive undo.
+ (setq this-command 'undo)
;; Check to see whether we're hitting a redo record, and if
;; so, ask the user whether she wants to skip the redo/undo pair.
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
(defun shell-command-on-region (start end command
&optional output-buffer replace
- error-buffer)
+ error-buffer display-error-buffer)
"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
`buffer-file-coding-system'. If the output is going to replace the region,
then it is decoded from that same coding system.
-The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
-REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
-systems by binding `coding-system-for-read' and
-`coding-system-for-write'.
+The noninteractive arguments are START, END, COMMAND,
+OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
+Noninteractive callers can specify coding systems by binding
+`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
+If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
+were any errors. (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
string
current-prefix-arg
current-prefix-arg
- shell-command-default-error-buffer)))
+ shell-command-default-error-buffer
+ t)))
(let ((error-file
(if error-buffer
(make-temp-file
(format-insert-file error-file nil)
;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end)))
- (display-buffer (current-buffer))))
+ (and display-error-buffer
+ (display-buffer (current-buffer)))))
(delete-file error-file))
exit-status))
`universal-argument-other-key' uses this to discard those events
from (this-command-keys), and reread only the final command.")
+(defvar overriding-map-is-bound nil
+ "Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.")
+
+(defvar saved-overriding-map nil
+ "The saved value of `overriding-terminal-local-map'.
+That variable gets restored to this value on exiting \"universal
+argument mode\".")
+
+(defun ensure-overriding-map-is-bound ()
+ "Check `overriding-terminal-local-map' is `universal-argument-map'."
+ (unless overriding-map-is-bound
+ (setq saved-overriding-map overriding-terminal-local-map)
+ (setq overriding-terminal-local-map universal-argument-map)
+ (setq overriding-map-is-bound t)))
+
+(defun restore-overriding-map ()
+ "Restore `overriding-terminal-local-map' to its saved value."
+ (setq overriding-terminal-local-map saved-overriding-map)
+ (setq overriding-map-is-bound nil))
+
(defun universal-argument ()
"Begin a numeric argument for the following command.
Digits or minus sign following \\[universal-argument] make up the numeric argument.
(interactive)
(setq prefix-arg (list 4))
(setq universal-argument-num-events (length (this-command-keys)))
- (setq overriding-terminal-local-map universal-argument-map))
+ (ensure-overriding-map-is-bound))
;; 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.
(if (eq arg '-)
(setq prefix-arg (list -4))
(setq prefix-arg arg)
- (setq overriding-terminal-local-map nil)))
+ (restore-overriding-map)))
(setq universal-argument-num-events (length (this-command-keys))))
(defun negative-argument (arg)
(t
(setq prefix-arg '-)))
(setq universal-argument-num-events (length (this-command-keys)))
- (setq overriding-terminal-local-map universal-argument-map))
+ (ensure-overriding-map-is-bound))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
(t
(setq prefix-arg digit))))
(setq universal-argument-num-events (length (this-command-keys)))
- (setq overriding-terminal-local-map universal-argument-map))
+ (ensure-overriding-map-is-bound))
;; For backward compatibility, minus with no modifiers is an ordinary
;; command if digits have already been entered.
(append (nthcdr universal-argument-num-events keylist)
unread-command-events)))
(reset-this-command-lengths)
- (setq overriding-terminal-local-map nil))
+ (restore-overriding-map))
\f
;;;; Window system cut and paste hooks.
The function takes one or two arguments.
The first argument, TEXT, is a string containing
the text which should be made available.
-The second, PUSH, if non-nil means this is a \"new\" kill;
-nil means appending to an \"old\" kill.")
+The second, optional, argument PUSH, has the same meaning as the
+similar argument to `x-set-cut-buffer', which see.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
The function should be called with no arguments. If the function
returns nil, then no other program has provided such text, and the top
of the Emacs kill ring should be used. If the function returns a
-string, that string should be put in the kill ring as the latest kill.
+string, then the caller of the function \(usually `current-kill')
+should put this string in the kill ring as the latest kill.
Note that the function should return a string only if a program other
than Emacs has provided a string for pasting; if Emacs provided the
Optional third arguments YANK-HANDLER controls how the STRING is later
inserted into a buffer; see `insert-for-yank' for details.
When a yank handler is specified, STRING must be non-empty (the yank
-handler is stored as a `yank-handler'text property on STRING).
+handler, if non-nil, is stored as a `yank-handler' text property on STRING).
When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
argument should still be a \"useful\" string for such uses."
(if (> (length string) 0)
(if yank-handler
- (put-text-property 0 1 'yank-handler yank-handler string))
+ (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"))))
(defun kill-append (string before-p &optional yank-handler)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
-Optional third argument YANK-HANDLER specifies the yank-handler text
-property to be set on the combined kill ring string. If the specified
-yank-handler arg differs from the yank-handler property of the latest
-kill string, STRING is added as a new kill ring element instead of
-being appending to the last kill.
+Optional third argument YANK-HANDLER, if non-nil, specifies the
+yank-handler text property to be set on the combined kill ring
+string. If the specified yank-handler arg differs from the
+yank-handler property of the latest kill string, this function
+adds the combined string to the kill ring as a new element,
+instead of replacing the last kill with it.
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))
you can use the killing commands to copy text from a read-only buffer.
This is the primitive for programs to kill text (as opposed to deleting it).
-Supply two arguments, character numbers indicating the stretch of text
+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.
-In Lisp code, optional third arg YANK-HANDLER specifies the yank-handler
-text property to be set on the killed text. See `insert-for-yank'."
+In Lisp code, optional third arg YANK-HANDLER, if non-nil,
+specifies the yank-handler text property to be set on the killed
+text. See `insert-for-yank'."
(interactive "r")
(condition-case nil
(let ((string (delete-and-extract-region beg end)))
(kill-append string (< end beg) yank-handler)
(kill-new string nil yank-handler)))
(when (or string (eq last-command 'kill-region))
- (setq this-command 'kill-region)))
+ (setq this-command 'kill-region))
+ nil)
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
;; in the region, are read-only.
(setq this-command 'kill-region)
;; This should barf, if appropriate, and give us the correct error.
(if kill-read-only-ok
- (message "Read only text copied to kill ring")
+ (progn (message "Read only text copied to kill ring") nil)
;; Signal an error if the buffer is read-only.
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
;; look like a C-g typed as a command.
(inhibit-quit t))
(if (pos-visible-in-window-p other-end (selected-window))
- (unless transient-mark-mode
+ (unless (and transient-mark-mode
+ (face-background 'region))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char other-end)
- (sit-for 1)
+ (sit-for blink-matching-delay)
;; Swap back.
(set-marker (mark-marker) other-end (current-buffer))
(goto-char opoint)
The value should be a list of text properties to discard or t,
which means to discard all text properties."
:type '(choice (const :tag "All" t) (repeat symbol))
- :group 'editing
+ :group 'killing
:version "21.4")
(defvar yank-window-start nil)
the value of the mark and point; it is guaranteed that START <= END.
Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
-(defun yank-pop (arg)
+(defun yank-pop (&optional arg)
"Replace just-yanked stretch of killed text with a different stretch.
This command is allowed only immediately after a `yank' or a `yank-pop'.
At such a time, the region contains a stretch of reinserted
(if (not (eq last-command 'yank))
(error "Previous command was not a yank"))
(setq this-command 'yank)
+ (unless arg (setq arg 1))
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
(if before
(push-mark (point))
(insert-for-yank (current-kill (cond
((listp arg) 0)
- ((eq arg '-) -1)
+ ((eq arg '-) -2)
(t (1- arg)))))
(if (consp arg)
;; This is like exchange-point-and-mark, but doesn't activate the mark.
(save-excursion
(end-of-visible-line) (point))))
(if (or (save-excursion
- (skip-chars-forward " \t" end)
+ ;; If trailing whitespace is visible,
+ ;; don't treat it as nothing.
+ (unless show-trailing-whitespace
+ (skip-chars-forward " \t" end))
(= (point) end))
(and kill-whole-line (bolp)))
(forward-visible-line 1)
If arg is negative, kill backward. Also kill the preceding newline.
\(This is meant to make C-x z work well with negative arguments.\)
If arg is zero, kill current line but exclude the trailing newline."
- (interactive "P")
- (setq arg (prefix-numeric-value arg))
+ (interactive "p")
(if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
(signal 'end-of-buffer nil))
(if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
purposes. See the documentation of `set-mark' for more information.
In Transient Mark mode, this does not activate the mark."
- (if (null (mark t))
- nil
+ (unless (null (mark t))
(setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
- (if (> (length mark-ring) mark-ring-max)
- (progn
- (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
- (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
+ (when (> (length mark-ring) mark-ring-max)
+ (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+ (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
(set-marker (mark-marker) (or location (point)) (current-buffer))
;; Now push the mark on the global mark ring.
(if (and global-mark-ring
;; Don't push another one.
nil
(setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
- (if (> (length global-mark-ring) global-mark-ring-max)
- (progn
- (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
- nil)
- (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
+ (when (> (length global-mark-ring) global-mark-ring-max)
+ (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
+ (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
(or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(defun pop-mark ()
"Pop off mark ring into the buffer's actual mark.
Does not set point. Does nothing if mark ring is empty."
- (if mark-ring
- (progn
- (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
- (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (deactivate-mark)
- (move-marker (car mark-ring) nil)
- (if (null (mark t)) (ding))
- (setq mark-ring (cdr mark-ring)))))
+ (when mark-ring
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (deactivate-mark)
+ (move-marker (car mark-ring) nil)
+ (if (null (mark t)) (ding))
+ (setq mark-ring (cdr mark-ring))))
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
(defun exchange-point-and-mark (&optional arg)
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
(interactive "p")
- (unless arg (setq arg 1))
+ (or arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
(if (save-excursion (end-of-line) (eobp))
;; When adding a newline, don't expand an abbrev.
`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
(interactive "p")
- (unless arg (setq arg 1))
+ (or arg (setq arg 1))
(if (interactive-p)
(condition-case nil
(line-move (- arg))
(goto-char (car pos1))
(insert word2))))
\f
-(defun backward-word (arg)
+(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
(interactive "p")
- (forward-word (- arg)))
+ (forward-word (- (or arg 1))))
(defun mark-word (arg)
"Set mark arg words away from point.
"Return the symbol or word that point is on (or a nearby one) as a string.
The return value includes no text properties.
If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a symbol or word.
+or adjacent to a symbol or word. In all cases the value can be nil
+if there is no word nearby.
The function, belying its name, normally finds a symbol.
If optional arg REALLY-WORD is non-nil, it finds just a word."
(save-excursion
(let* ((oldpoint (point)) (start (point)) (end (point))
- (syntaxes (if really-word "w_" "w"))
+ (syntaxes (if really-word "w" "w_"))
(not-syntaxes (concat "^" syntaxes)))
(skip-syntax-backward syntaxes) (setq start (point))
(goto-char oldpoint)
;; (Actually some major modes use a different auto-fill function,
;; but this one is the default one.)
(defun do-auto-fill ()
- (let (fc justify bol give-up
+ (let (fc justify give-up
(fill-prefix fill-prefix))
(if (or (not (setq justify (current-justification)))
(null (setq fc (current-fill-column)))
(and (eq justify 'left)
(<= (current-column) fc))
- (save-excursion (beginning-of-line)
- (setq bol (point))
- (and auto-fill-inhibit-regexp
+ (and auto-fill-inhibit-regexp
+ (save-excursion (beginning-of-line)
(looking-at auto-fill-inhibit-regexp))))
nil ;; Auto-filling not required
(if (memq justify '(full center right))
;; Determine where to split the line.
(let* (after-prefix
(fill-point
- (let ((opoint (point)))
- (save-excursion
- (beginning-of-line)
- (setq after-prefix (point))
- (and fill-prefix
- (looking-at (regexp-quote fill-prefix))
- (setq after-prefix (match-end 0)))
- (move-to-column (1+ fc))
- (fill-move-to-break-point after-prefix)
- (point)))))
+ (save-excursion
+ (beginning-of-line)
+ (setq after-prefix (point))
+ (and fill-prefix
+ (looking-at (regexp-quote fill-prefix))
+ (setq after-prefix (match-end 0)))
+ (move-to-column (1+ fc))
+ (fill-move-to-break-point after-prefix)
+ (point))))
;; See whether the place we found is any good.
(if (save-excursion
(setq arg (current-column)))
(if (not (integerp arg))
;; Disallow missing argument; it's probably a typo for C-x C-f.
- (error "set-fill-column requires an explicit argument")
+ (error "Set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
\f
When Column Number mode is enabled, the column number appears
in the mode line."
:global t :group 'editing-basics :require nil)
+
+(define-minor-mode size-indication-mode
+ "Toggle Size Indication mode.
+With arg, turn Size Indication mode on iff arg is positive. When
+Size Indication mode is enabled, the size of the accessible part
+of the buffer appears in the mode line."
+ :global t :group 'editing-basics :require nil)
\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
(point)))))
(let* ((oldpos (point))
(blinkpos)
- (mismatch))
+ (mismatch)
+ matching-paren)
(save-excursion
(save-restriction
(if blink-matching-paren-distance
(setq blinkpos (scan-sexps oldpos -1)))
(error nil)))
(and blinkpos
- (/= (char-syntax (char-after blinkpos))
- ?\$)
- (setq mismatch
- (or (null (matching-paren (char-after blinkpos)))
+ (save-excursion
+ (goto-char blinkpos)
+ (not (looking-at "\\s$")))
+ (setq matching-paren
+ (or (and parse-sexp-lookup-properties
+ (let ((prop (get-text-property blinkpos 'syntax-table)))
+ (and (consp prop)
+ (eq (car prop) 4)
+ (cdr prop))))
+ (matching-paren (char-after blinkpos)))
+ mismatch
+ (or (null matching-paren)
(/= (char-after (1- oldpos))
- (matching-paren (char-after blinkpos))))))
+ matching-paren))))
(if mismatch (setq blinkpos nil))
(if blinkpos
;; Don't log messages about paren matching.
(same-window-buffer-names nil)
(same-window-regexps nil))
(funcall switch-function "*mail*")))
- (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
- (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
- (body (cdr (assoc-ignore-case "body" other-headers))))
+ (let ((cc (cdr (assoc-string "cc" other-headers t)))
+ (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
+ (body (cdr (assoc-string "body" other-headers t))))
(or (mail continue to subject in-reply-to cc yank-action send-actions)
continue
(error "Message aborted"))
(read-variable (format "Set variable (default %s): " default-var)
default-var)
(read-variable "Set variable: ")))
- (minibuffer-help-form '(describe-variable var))
- (prop (get var 'variable-interactive))
- (prompt (format "Set %s%s to value: " var
- (cond ((local-variable-p var)
- " (buffer-local)")
- ((or current-prefix-arg
- (local-variable-if-set-p var))
- " buffer-locally")
- (t " globally"))))
- (val (if prop
- ;; Use VAR's `variable-interactive' property
- ;; as an interactive spec for prompting.
- (call-interactively `(lambda (arg)
- (interactive ,prop)
- arg))
- (read
- (read-string prompt nil
- 'set-variable-value-history)))))
- (list var val current-prefix-arg)))
+ (minibuffer-help-form '(describe-variable var))
+ (prop (get var 'variable-interactive))
+ (prompt (format "Set %s%s to value: " var
+ (cond ((local-variable-p var)
+ " (buffer-local)")
+ ((or current-prefix-arg
+ (local-variable-if-set-p var))
+ " buffer-locally")
+ (t " globally"))))
+ (val (if prop
+ ;; Use VAR's `variable-interactive' property
+ ;; as an interactive spec for prompting.
+ (call-interactively `(lambda (arg)
+ (interactive ,prop)
+ arg))
+ (read
+ (read-string prompt nil
+ 'set-variable-value-history)))))
+ (list var val current-prefix-arg)))
(and (custom-variable-p var)
(not (get var 'custom-type))
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
- (let ((buffer (or buffer completion-reference-buffer))
- (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
- (buffer-name buffer))))
+ (let* ((buffer (or buffer completion-reference-buffer))
+ (mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
(if (and mini-p
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
+ ;; Set buffer so buffer-local choose-completion-string-functions works.
+ (set-buffer buffer)
(unless (run-hook-with-args-until-success
'choose-completion-string-functions
choice buffer mini-p base-size)
;; Insert the completion into the buffer where it was requested.
- (set-buffer buffer)
(if base-size
(delete-region (+ base-size (if mini-p
(minibuffer-prompt-end)
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
+(defface completions-first-difference
+ '((t (:inherit bold)))
+ "Face put on the first uncommon character in completions in *Completions* buffer."
+ :group 'completion)
+
+(defface completions-common-part
+ '((t (:inherit default)))
+ "Face put on the common prefix substring in completions in *Completions* buffer.
+The idea of `completions-common-part' is that you can use it to
+make the common parts less visible than normal, so that the rest
+of the differing parts is, by contrast, slightly highlighted."
+ :group 'completion)
+
+;; This is for packages that need to bind it to a non-default regexp
+;; in order to make the first-differing character highlight work
+;; to their liking
+(defvar completion-root-regexp "^/"
+ "Regexp to use in `completion-setup-function' to find the root directory.")
(defun completion-setup-function ()
- (save-excursion
- (let ((mainbuf (current-buffer))
- (mbuf-contents (minibuffer-contents)))
- ;; When reading a file name in the minibuffer,
- ;; set default-directory in the minibuffer
- ;; so it will get copied into the completion list buffer.
- (if minibuffer-completing-file-name
- (with-current-buffer mainbuf
- (setq default-directory (file-name-directory mbuf-contents))))
- (set-buffer standard-output)
+ (let ((mainbuf (current-buffer))
+ (mbuf-contents (minibuffer-contents)))
+ ;; When reading a file name in the minibuffer,
+ ;; set default-directory in the minibuffer
+ ;; so it will get copied into the completion list buffer.
+ (if minibuffer-completing-file-name
+ (with-current-buffer mainbuf
+ (setq default-directory (file-name-directory mbuf-contents))))
+ ;; If partial-completion-mode is on, point might not be after the
+ ;; last character in the minibuffer.
+ ;; FIXME: This still doesn't work if the text to be completed
+ ;; starts with a `-'.
+ (when (and partial-completion-mode (not (eobp)))
+ (setq mbuf-contents
+ (substring mbuf-contents 0 (- (point) (point-max)))))
+ (with-current-buffer standard-output
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
;; use the number of chars before the start of the
;; last file name component.
(setq completion-base-size
- (save-excursion
- (set-buffer mainbuf)
- (goto-char (point-max))
- (skip-chars-backward "^/")
- (- (point) (minibuffer-prompt-end))))
+ (with-current-buffer mainbuf
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward completion-root-regexp)
+ (- (point) (minibuffer-prompt-end)))))
;; Otherwise, in minibuffer, the whole input is being completed.
- (save-match-data
- (if (minibufferp mainbuf)
- (setq completion-base-size 0))))
+ (if (minibufferp mainbuf)
+ (setq completion-base-size 0)))
+ ;; Put faces on first uncommon characters and common parts.
+ (when completion-base-size
+ (let* ((common-string-length
+ (- (length mbuf-contents) completion-base-size))
+ (element-start (next-single-property-change
+ (point-min)
+ 'mouse-face))
+ (element-common-end
+ (+ (or element-start nil) common-string-length))
+ (maxp (point-max)))
+ (while (and element-start (< element-common-end maxp))
+ (when (and (get-char-property element-start 'mouse-face)
+ (get-char-property element-common-end 'mouse-face))
+ (put-text-property element-start element-common-end
+ 'font-lock-face 'completions-common-part)
+ (put-text-property element-common-end (1+ element-common-end)
+ 'font-lock-face 'completions-first-difference))
+ (setq element-start (next-single-property-change
+ element-start
+ 'mouse-face))
+ (if element-start
+ (setq element-common-end (+ element-start common-string-length))))))
+ ;; Insert help string.
(goto-char (point-min))
(if (display-mouse-p)
(insert (substitute-command-keys
;; - syntax-table
;; - overlays
(defun clone-buffer (&optional newname display-flag)
- "Create a twin copy of the current buffer.
-If NEWNAME is nil, it defaults to the current buffer's name;
-NEWNAME is modified by adding or incrementing <N> at the end as necessary.
+ "Create and return a twin copy of the current buffer.
+Unlike an indirect buffer, the new buffer can be edited
+independently of the old one (if it is not read-only).
+NEWNAME is the name of the new buffer. It may be modified by
+adding or incrementing <N> at the end as necessary to create a
+unique buffer name. If nil, it defaults to the name of the
+current buffer, with the proper suffix. If DISPLAY-FLAG is
+non-nil, the new buffer is shown with `pop-to-buffer'. Trying to
+clone a file-visiting buffer, or a buffer whose major mode symbol
+has a non-nil `no-clone' property, results in an error.
+
+Interactively, DISPLAY-FLAG is t and NEWNAME is the name of the
+current buffer with appropriate suffix. However, if a prefix
+argument is given, then the command prompts for NEWNAME in the
+minibuffer.
-If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
This runs the normal hook `clone-buffer-hook' in the new buffer
after it has been set up properly in other respects."
(interactive
;
(provide 'simple)
+
+;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
;;; simple.el ends here