;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;;; Code:
-(eval-when-compile (require 'cl)) ;For define-minor-mode.
-
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
(define-key map "g" 'revert-buffer)
- (define-key map "z" 'kill-this-buffer)
map))
(put 'special-mode 'mode-class 'special)
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
+(defcustom delete-trailing-lines t
+ "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
+Trailing lines are deleted only if `delete-trailing-whitespace'
+is called on the entire buffer (rather than an active region)."
+ :type 'boolean
+ :group 'editing
+ :version "24.3")
+
(defun delete-trailing-whitespace (&optional start end)
- "Delete all the trailing whitespace across the current buffer.
-All whitespace after the last non-whitespace character in a line is deleted.
-This respects narrowing, created by \\[narrow-to-region] and friends.
-A formfeed is not considered whitespace by this function.
-If END is nil, also delete all trailing lines at the end of the buffer.
-If the region is active, only delete whitespace within the region."
+ "Delete trailing whitespace between START and END.
+If called interactively, START and END are the start/end of the
+region if the mark is active, or of the buffer's accessible
+portion if the mark is inactive.
+
+This command deletes whitespace characters after the last
+non-whitespace character in each line between START and END. It
+does not consider formfeed characters to be whitespace.
+
+If this command acts on the entire buffer (i.e. if called
+interactively with the mark inactive, or called from Lisp with
+END nil), it also deletes all trailing lines at the end of the
+buffer if the variable `delete-trailing-lines' is non-nil."
(interactive (progn
(barf-if-buffer-read-only)
(if (use-region-p)
;; Delete trailing empty lines.
(goto-char end-marker)
(when (and (not end)
+ delete-trailing-lines
;; Really the end of buffer.
- (save-restriction (widen) (eobp))
+ (= (point-max) (1+ (buffer-size)))
(<= (skip-chars-backward "\n") -2))
(delete-region (1+ (point)) end-marker))
(set-marker end-marker nil))))
(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))
(concat " in " (buffer-name buffer))
"")))
;; Read the argument, offering that number (if any) as default.
- (list (read-number (format (if default "Goto line%s (%s): "
- "Goto line%s: ")
- buffer-prompt
- default)
- default)
+ (list (read-number (format "Goto line%s: " buffer-prompt)
+ (list default (line-number-at-pos)))
buffer))))
;; Switch to the desired buffer, one way or another.
(if buffer
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
-(defun count-words-region (start end)
+(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
If called interactively, print a message reporting the number of
-lines, words, and chars in the region.
+lines, words, and characters in the region (whether or not the
+region is active); with prefix ARG, report for the entire buffer
+rather than the region.
+
If called from Lisp, return the number of words between positions
START and END."
- (interactive "r")
- (if (called-interactively-p 'any)
- (count-words--message "Region" start end)
- (count-words start end)))
+ (interactive (if current-prefix-arg
+ (list nil nil current-prefix-arg)
+ (list (region-beginning) (region-end) nil)))
+ (cond ((not (called-interactively-p 'any))
+ (count-words start end))
+ (arg
+ (count-words--buffer-message))
+ (t
+ (count-words--message "Region" start end))))
(defun count-words (start end)
"Count words between START and END.
((use-region-p)
(call-interactively 'count-words-region))
(t
- (count-words--message "Buffer" (point-min) (point-max)))))
+ (count-words--buffer-message))))
+
+(defun count-words--buffer-message ()
+ (count-words--message
+ (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
+ (point-min) (point-max)))
(defun count-words--message (str start end)
(let ((lines (count-lines start end))
(if (null command-name) (setq command-name (read-extended-command)))
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
- (not executing-kbd-macro)
- (where-is-internal function overriding-local-map t))))
+ (not executing-kbd-macro)
+ (where-is-internal function overriding-local-map t))))
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
- ;; Set this_command_keys to the concatenation of saved-keys and
- ;; function, followed by a RET.
(setq this-command function)
+ ;; Normally `real-this-command' should never be changed, but here we really
+ ;; want to pretend that M-x <cmd> RET is nothing more than a "key
+ ;; binding" for <cmd>, so the command the user really wanted to run is
+ ;; `function' and not `execute-extended-command'. The difference is
+ ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
+ (setq real-this-command function)
(let ((prefix-arg prefixarg))
(command-execute function 'record))
;; If enabled, show which key runs this command.
(defun minibuffer-history-isearch-search ()
"Return the proper search function, for isearch in minibuffer history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within minibuffer text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the minibuffer prompt when
- ;; searching forward. Lazy-highlight calls this lambda with the
- ;; bound arg, so skip the minibuffer prompt.
- (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
- (goto-char (minibuffer-prompt-end)))
- (or
- ;; 1. First try searching in the initial minibuffer text
- (funcall search-fun string
- (if isearch-forward bound (minibuffer-prompt-end))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the minibuffer successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current minibuffer text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- (next-history-element 1)
- (goto-char (minibuffer-prompt-end)))
- (t
- (previous-history-element 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until next-history-element
- ;; or previous-history-element raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the minibuffer prompt
- (minibuffer-prompt-end))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil when next(prev)-history-element fails
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within minibuffer text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the minibuffer prompt when
+ ;; searching forward. Lazy-highlight calls this lambda with the
+ ;; bound arg, so skip the minibuffer prompt.
+ (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
+ (goto-char (minibuffer-prompt-end)))
+ (or
+ ;; 1. First try searching in the initial minibuffer text
+ (funcall search-fun string
+ (if isearch-forward bound (minibuffer-prompt-end))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the minibuffer successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current minibuffer text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ (next-history-element 1)
+ (goto-char (minibuffer-prompt-end)))
+ (t
+ (previous-history-element 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until next-history-element
+ ;; or previous-history-element raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the minibuffer prompt
+ (minibuffer-prompt-end))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil when next(prev)-history-element fails
+ (error nil)))))))
(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
"Display the minibuffer history search prompt.
"Wrap the minibuffer history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `minibuffer-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; minibuffer history element.
- (if isearch-forward
- (goto-history-element (length (symbol-value minibuffer-history-variable)))
- (goto-history-element 0))
- (setq isearch-success t))
+ ;; When `minibuffer-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; minibuffer history element.
+ (if isearch-forward
+ (goto-history-element (length (symbol-value minibuffer-history-variable)))
+ (goto-history-element 0))
+ (setq isearch-success t)
(goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
(defun minibuffer-history-isearch-push-state ()
;; 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.
- (let ((modified (buffer-modified-p))
- (recent-save (recent-auto-save-p))
- message)
+ (let* ((modified (buffer-modified-p))
+ ;; For an indirect buffer, look in the base buffer for the
+ ;; auto-save data.
+ (base-buffer (or (buffer-base-buffer) (current-buffer)))
+ (recent-save (with-current-buffer base-buffer
+ (recent-auto-save-p)))
+ message)
;; 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'.
;; so, ask the user whether she wants to skip the redo/undo pair.
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
(or (eq (selected-window) (minibuffer-window))
- (setq message (if undo-in-region
- (if equiv "Redo in region!" "Undo in region!")
- (if equiv "Redo!" "Undo!"))))
+ (setq message (format "%s%s!"
+ (if (or undo-no-redo (not equiv))
+ "Undo" "Redo")
+ (if undo-in-region " in region" ""))))
(when (and (consp equiv) undo-no-redo)
;; The equiv entry might point to another redo record if we have done
;; undo-redo-undo-redo-... so skip to the very last equiv.
;; Record what the current undo list says,
;; so the next command can tell if the buffer was modified in between.
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save))
+ (with-current-buffer base-buffer
+ (delete-auto-save-file-if-necessary recent-save)))
;; Display a message announcing success.
(if message
(message "%s" message))))
(or hist 'shell-command-history)
args)))
+(defcustom async-shell-command-buffer 'confirm-new-buffer
+ "What to do when the output buffer is used by another shell command.
+This option specifies how to resolve the conflict where a new command
+wants to direct its output to the buffer `*Async Shell Command*',
+but this buffer is already taken by another running shell command.
+
+The value `confirm-kill-process' is used to ask for confirmation before
+killing the already running process and running a new process
+in the same buffer, `confirm-new-buffer' for confirmation before running
+the command in a new buffer with a name other than the default buffer name,
+`new-buffer' for doing the same without confirmation,
+`confirm-rename-buffer' for confirmation before renaming the existing
+output buffer and running a new command in the default buffer,
+`rename-buffer' for doing the same without confirmation."
+ :type '(choice (const :tag "Confirm killing of running command"
+ confirm-kill-process)
+ (const :tag "Confirm creation of a new buffer"
+ confirm-new-buffer)
+ (const :tag "Create a new buffer"
+ new-buffer)
+ (const :tag "Confirm renaming of existing buffer"
+ confirm-rename-buffer)
+ (const :tag "Rename the existing buffer"
+ rename-buffer))
+ :group 'shell
+ :version "24.3")
+
(defun async-shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND asynchronously in background.
-Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
-surrounded by whitespace and executes the command asynchronously.
+Like `shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
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
(interactive
(list
(read-shell-command "Async shell command: " nil nil
- (and buffer-file-name
- (file-relative-name buffer-file-name)))
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
current-prefix-arg
shell-command-default-error-buffer))
(unless (string-match "&[ \t]*\\'" command)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
-If COMMAND ends in ampersand, execute it asynchronously.
+If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
+That buffer is in shell mode. You can also use
+`async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
the buffer `*Shell Command Output*'. If the output is short enough to
proc)
;; Remove the ampersand.
(setq command (substring command 0 (match-beginning 0)))
- ;; If will kill a process, query first.
+ ;; Ask the user what to do with already running process.
(setq proc (get-buffer-process buffer))
- (if proc
- (if (yes-or-no-p "A command is running. Kill it? ")
+ (when proc
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*")))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*"))))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
+ (progn
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))))
(with-current-buffer buffer
(setq buffer-read-only nil)
;; Setting buffer-read-only to nil doesn't suffice
falling back to `default-process-coding-system' if no match for COMMAND
is found in `process-coding-system-alist'.
-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'.
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
-`resize-mini-windows' is non-nil), it is shown there. Otherwise
-it is displayed in the buffer `*Shell Command Output*'. The output
-is available in that buffer in both cases.
+`resize-mini-windows' is non-nil), it is shown there.
+Otherwise it is displayed in the buffer `*Shell Command Output*'.
+The output is available in that buffer in both cases.
If there is output and an error, a message about the error
-appears at the end of the output.
-
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-If the optional fourth argument OUTPUT-BUFFER is non-nil,
-that says to put the output in some other buffer.
-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in the current buffer.
-In either case, the output is inserted after point (leaving mark after it).
-
-If REPLACE, the optional fifth argument, is non-nil, that means insert
-the output in place of text from START to END, putting point and mark
+appears at the end of the output. If there is no output, or if
+output is inserted in the current buffer, the buffer `*Shell
+Command Output*' is deleted.
+
+Optional fourth arg OUTPUT-BUFFER specifies where to put the
+command's output. If the value is a buffer or buffer name, put
+the output there. Any other value, including nil, means to
+insert the output in the current buffer. In either case, the
+output is inserted after point (leaving mark after it).
+
+Optional fifth arg REPLACE, if non-nil, means to insert the
+output in place of text from START to END, putting point and mark
around it.
-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."
+Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
+or buffer name to which to direct the command's standard error
+output. If nil, error output is mingled with regular output.
+When called interactively, `shell-command-default-error-buffer'
+is used for ERROR-BUFFER.
+
+Optional seventh arg DISPLAY-ERROR-BUFFER, if non-nil, means to
+display the error buffer if there were any errors. When called
+interactively, this is t."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
(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)))))
"network")
(if (plist-get contact :server)
(format "server on %s"
- (plist-get contact :server))
+ (or
+ (plist-get contact :host)
+ (plist-get contact :local)))
(format "connection to %s"
(plist-get contact :host))))
(format "(serial port %s%s)"
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
-\"*Process List\".
+\"*Process List*\".
The return value is always nil."
(interactive)
(or (fboundp 'process-list)
(defvar interprogram-cut-function nil
"Function to call to make a killed region available to other programs.
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls whenever text
-is put in the kill ring, to make the new kill available to other
-programs.
-
-The function takes one argument, TEXT, which is a string containing
-the text which should be made available.")
+This variable holds a function that Emacs calls whenever text is
+put in the kill ring, to make the new kill available to other
+programs. The function takes one argument, TEXT, which is a
+string containing the text which should be made available.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
-
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls to obtain
-text that other programs have provided for pasting.
-
-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, then the caller of the function \(usually `current-kill')
-should put this string in the kill ring as the latest kill.
-
-This function may also return a list of strings if the window
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
+
+This variable holds a function that Emacs calls to obtain text
+that other programs have provided for pasting. The function is
+called with no arguments. If no other program has provided text
+to paste, the function should return nil (in which case the
+caller, usually `current-kill', should use the top of the Emacs
+kill ring). If another program has provided text to paste, the
+function should return that text as a string (in which case the
+caller should put this string in the kill ring as the latest
+kill).
+
+The function may also return a list of strings if the window
system supports multiple selections. The first string will be
-used as the pasted text, but the other will be placed in the
-kill ring for easy access via `yank-pop'.
-
-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
-most recent string, the function should return nil. If it is
-difficult to tell whether Emacs or some other program provided the
-current string, it is probably good enough to return nil if the string
-is equal (according to `string=') to the last text Emacs provided.")
+used as the pasted text, but the other will be placed in the kill
+ring for easy access via `yank-pop'.
+
+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 most recent string, the function should return nil.
+If it is difficult to tell whether Emacs or some other program
+provided the current string, it is probably good enough to return
+nil if the string is equal (according to `string=') to the last
+text Emacs provided.")
\f
(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
(defcustom yank-pop-change-selection nil
- "If non-nil, rotating the kill ring changes the window system selection."
+ "Whether rotating the kill ring changes the window system selection.
+If non-nil, whenever the kill ring is rotated (usually via the
+`yank-pop' command), Emacs also calls `interprogram-cut-function'
+to copy the new kill to the window system selection."
:type 'boolean
:group 'killing
:version "23.1")
(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
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of called-interactively-p is correct
- ;; because the code it controls just gives the user visual feedback.
+ ;; This use of called-interactively-p is correct because the code it
+ ;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
- (let ((other-end (if (= (point) beg) end beg))
- (opoint (point))
- ;; Inhibit quitting so we can make a quit here
- ;; look like a C-g typed as a command.
- (inhibit-quit t))
- (if (pos-visible-in-window-p other-end (selected-window))
- ;; Swap point-and-mark quickly so as to show the region that
- ;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region))
- ;; Swap point and mark.
- (set-marker (mark-marker) (point) (current-buffer))
- (goto-char other-end)
- (sit-for blink-matching-delay)
- ;; Swap back.
- (set-marker (mark-marker) other-end (current-buffer))
- (goto-char opoint)
- ;; If user quit, deactivate the mark
- ;; as C-g would as a command.
- (and quit-flag mark-active
- (deactivate-mark)))
- (let* ((killed-text (current-kill 0))
- (message-len (min (length killed-text) 40)))
- (if (= (point) beg)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (substring killed-text (- message-len)))
- (message "Saved text from \"%s\""
- (substring killed-text 0 message-len))))))))
+ (indicate-copied-region)))
+
+(defun indicate-copied-region (&optional message-len)
+ "Indicate that the region text has been copied interactively.
+If the mark is visible in the selected window, blink the cursor
+between point and mark if there is currently no active region
+highlighting.
+
+If the mark lies outside the selected window, display an
+informative message containing a sample of the copied text. The
+optional argument MESSAGE-LEN, if non-nil, specifies the length
+of this sample text; it defaults to 40."
+ (let ((mark (mark t))
+ (point (point))
+ ;; Inhibit quitting so we can make a quit here
+ ;; look like a C-g typed as a command.
+ (inhibit-quit t))
+ (if (pos-visible-in-window-p mark (selected-window))
+ ;; Swap point-and-mark quickly so as to show the region that
+ ;; was selected. Don't do it if the region is highlighted.
+ (unless (and (region-active-p)
+ (face-background 'region))
+ ;; Swap point and mark.
+ (set-marker (mark-marker) (point) (current-buffer))
+ (goto-char mark)
+ (sit-for blink-matching-delay)
+ ;; Swap back.
+ (set-marker (mark-marker) mark (current-buffer))
+ (goto-char point)
+ ;; If user quit, deactivate the mark
+ ;; as C-g would as a command.
+ (and quit-flag mark-active
+ (deactivate-mark)))
+ (let ((len (min (abs (- mark point))
+ (or message-len 40))))
+ (if (< point mark)
+ ;; Don't say "killed"; that is misleading.
+ (message "Saved text until \"%s\""
+ (buffer-substring-no-properties (- mark len) mark))
+ (message "Saved text from \"%s\""
+ (buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to append to previous kill.
\f
;; Yanking.
+(defcustom yank-handled-properties
+ '((font-lock-face . yank-handle-font-lock-face-property)
+ (category . yank-handle-category-property))
+ "List of special text property handling conditions for yanking.
+Each element should have the form (PROP . FUN), where PROP is a
+property symbol and FUN is a function. When the `yank' command
+inserts text into the buffer, it scans the inserted text for
+stretches of text that have `eq' values of the text property
+PROP; for each such stretch of text, FUN is called with three
+arguments: the property's value in that text, and the start and
+end positions of the text.
+
+This is done prior to removing the properties specified by
+`yank-excluded-properties'."
+ :group 'killing
+ :version "24.3")
+
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
- '(read-only invisible intangible field mouse-face help-echo local-map keymap
- yank-handler follow-link fontified)
+ '(category field follow-link fontified font-lock-face help-echo
+ intangible invisible keymap local-map mouse-face read-only
+ yank-handler)
"Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
-which means to discard all text properties."
+which means to discard all text properties.
+
+See also `yank-handled-properties'."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
- :version "22.1")
+ :version "24.3")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
-More precisely, reinsert the stretch of killed text most recently
-killed OR yanked. Put point at end, and set mark at beginning.
-With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
-With argument N, reinsert the Nth most recently killed stretch of killed
-text.
+More precisely, reinsert the most recent kill, which is the
+stretch of killed text most recently killed OR yanked. Put point
+at the end, and set mark at the beginning without activating it.
+With just \\[universal-argument] as argument, put point at beginning, and mark at end.
+With argument N, reinsert the Nth most recent kill.
-When this command inserts killed text into the buffer, it honors
-`yank-excluded-properties' and `yank-handler' as described in the
-doc string for `insert-for-yank-1', which see.
+When this command inserts text into the buffer, it honors the
+`yank-handled-properties' and `yank-excluded-properties'
+variables, and the `yank-handler' text property. See
+`insert-for-yank-1' for details.
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "If non-nil, `kill-line' with no arg at beg of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line."
:type 'boolean
:group 'killing)
(cond (saved-region-selection
(x-set-selection 'PRIMARY saved-region-selection)
(setq saved-region-selection nil))
- ((/= (region-beginning) (region-end))
+ ;; If another program has acquired the selection, region
+ ;; deactivation should not clobber it (Bug#11772).
+ ((and (/= (region-beginning) (region-end))
+ (or (x-selection-owner-p 'PRIMARY)
+ (null (x-selection-exists-p 'PRIMARY))))
(x-set-selection 'PRIMARY
- (buffer-substring-no-properties
- (region-beginning)
- (region-end))))))
+ (buffer-substring (region-beginning)
+ (region-end))))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
(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)
(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.
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
- :variable (eq auto-fill-function normal-auto-fill-function))
+ :variable (auto-fill-function
+ . (lambda (v) (setq auto-fill-function
+ (if v normal-auto-fill-function)))))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
filled in. \\[quoted-insert] still inserts characters in
overwrite mode; this is supposed to make it easier to insert
characters when necessary."
- :variable (eq overwrite-mode 'overwrite-mode-textual))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-textual)))))
(define-minor-mode binary-overwrite-mode
"Toggle Binary Overwrite mode.
Note that Binary Overwrite mode is not its own minor mode; it is
a specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
- :variable (eq overwrite-mode 'overwrite-mode-binary))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-binary)))))
(define-minor-mode line-number-mode
"Toggle line number display in the mode line (Line Number mode).
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
- (buffer-substring-no-properties beg end))))
- (owindow (selected-window)))
+ (buffer-substring-no-properties beg end)))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
- (select-window (posn-window (event-start event)))
- (if (and (one-window-p t 'selected-frame)
- (window-dedicated-p (selected-window)))
- ;; This is a special buffer's frame
- (iconify-frame (selected-frame))
- (or (window-dedicated-p (selected-window))
- (bury-buffer)))
- (select-window
- (or (get-buffer-window buffer 0)
- owindow))
+ (quit-window nil (posn-window (event-start event)))
(with-current-buffer buffer
(choose-completion-string
(point))))
(defun choose-completion-delete-max-match (string)
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
(delete-region (choose-completion-guess-base-position string) (point)))
-(make-obsolete 'choose-completion-delete-max-match
- 'choose-completion-guess-base-position "23.2")
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
"Finish setup of the completions buffer.
Called from `temp-buffer-show-hook'."
(when (eq major-mode 'completion-list-mode)
- (toggle-read-only 1)))
+ (setq buffer-read-only t)))
(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
(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))
have both Backspace, Delete and F1 keys.
See also `normal-erase-is-backspace'."
- :variable (eq (terminal-parameter
- nil 'normal-erase-is-backspace) 1)
+ :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1)
+ . (lambda (v)
+ (setf (terminal-parameter nil 'normal-erase-is-backspace)
+ (if v 1 0))))
(let ((enabled (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace))))
(defvar vis-mode-saved-buffer-invisibility-spec nil
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+(define-minor-mode read-only-mode
+ "Change whether the current buffer is read-only.
+With prefix argument ARG, make the buffer read-only if ARG is
+positive, otherwise make it writable. If buffer is read-only
+and `view-read-only' is non-nil, enter view mode.
+
+Do not call this from a Lisp program unless you really intend to
+do the same thing as the \\[read-only-mode] command, including
+possibly enabling or disabling View mode. Also, note that this
+command works by setting the variable `buffer-read-only', which
+does not affect read-only regions caused by text properties. To
+ignore read-only status in a Lisp program (whether due to text
+properties or buffer state), bind `inhibit-read-only' temporarily
+to a non-nil value."
+ :variable buffer-read-only
+ (cond
+ ((and (not buffer-read-only) view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and buffer-read-only view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))))
+
(define-minor-mode visible-mode
"Toggle making all invisible text temporarily visible (Visible mode).
With a prefix argument ARG, enable Visible mode if ARG is
HCoop / bpt / emacs.git / blobdiff