diff options
Diffstat (limited to 'lisp/simple.el')
| -rw-r--r-- | lisp/simple.el | 999 |
1 files changed, 624 insertions, 375 deletions
diff --git a/lisp/simple.el b/lisp/simple.el index b7165c9f6a9..5867561da26 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1,6 +1,6 @@ ;;; simple.el --- basic editing commands for Emacs -;; Copyright (C) 1985-1987, 1993-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;For define-minor-mode. - (declare-function widget-convert "wid-edit" (type &rest args)) (declare-function shell-mode "shell" ()) @@ -321,9 +319,11 @@ select the source buffer." (define-minor-mode next-error-follow-minor-mode "Minor mode for compilation, occur and diff modes. +With a prefix argument ARG, enable mode if ARG is positive, and +disable it otherwise. If called from Lisp, enable mode if ARG is +omitted or nil. When turned on, cursor motion in the compilation, grep, occur or diff -buffer causes automatic display of the corresponding source code -location." +buffer causes automatic display of the corresponding source code location." :group 'next-error :init-value nil :lighter " Fol" (if (not next-error-follow-minor-mode) (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t) @@ -365,7 +365,6 @@ Other major modes are defined by comparison with this one." (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) @@ -564,13 +563,28 @@ On nonblank line, delete any immediately following blank lines." (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) @@ -590,8 +604,9 @@ If the region is active, only delete whitespace within the region." ;; 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)))) @@ -815,7 +830,7 @@ instead of deleted." :type '(choice (const :tag "Delete active region" t) (const :tag "Kill active region" kill) (const :tag "Do ordinary deletion" nil)) - :group 'editing + :group 'killing :version "24.1") (defun delete-backward-char (n &optional killflag) @@ -891,16 +906,23 @@ that uses or sets the mark." ;; Counting lines, one way or another. (defun goto-line (line &optional buffer) - "Goto LINE, counting from line 1 at beginning of buffer. -Normally, move point in the current buffer, and leave mark at the -previous position. With just \\[universal-argument] as argument, -move point in the most recently selected other buffer, and switch to it. + "Go to LINE, counting from line 1 at beginning of buffer. +If called interactively, a numeric prefix argument specifies +LINE; without a numeric prefix argument, read LINE from the +minibuffer. -If there's a number in the buffer at point, it is the default for LINE. +If optional argument BUFFER is non-nil, switch to that buffer and +move to line LINE there. If called interactively with \\[universal-argument] +as argument, BUFFER is the most recently selected other buffer. + +Prior to moving point, this function sets the mark (without +activating it), unless Transient Mark mode is enabled and the +mark is already active. This function is usually the wrong thing to use in a Lisp program. What you probably want instead is something like: - (goto-char (point-min)) (forward-line (1- N)) + (goto-char (point-min)) + (forward-line (1- N)) If at all possible, an even better solution is to use char counts rather than line counts." (interactive @@ -925,11 +947,8 @@ rather than line counts." (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 @@ -946,47 +965,65 @@ rather than line counts." (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line))))) -(defun count-words-region (start end) - "Return the number of words between START and 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 characters in the region." - (interactive "r") - (let ((words 0)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (forward-word 1) - (setq words (1+ words))))) - (when (called-interactively-p 'interactive) - (count-words--message "Region" - (count-lines start end) - words - (- end start))) - words)) - -(defun count-words () - "Display the number of lines, words, and characters in the buffer. -In Transient Mark mode when the mark is active, display the -number of lines, words, and characters in the region." - (interactive) - (if (use-region-p) - (call-interactively 'count-words-region) - (let* ((beg (point-min)) - (end (point-max)) - (lines (count-lines beg end)) - (words (count-words-region beg end)) - (chars (- end beg))) - (count-words--message "Buffer" lines words chars)))) - -(defun count-words--message (str lines words chars) - (message "%s has %d line%s, %d word%s, and %d character%s." - str - lines (if (= lines 1) "" "s") - words (if (= words 1) "" "s") - chars (if (= chars 1) "" "s"))) - -(defalias 'count-lines-region 'count-words-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 (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. +If called interactively, START and END are normally the start and +end of the buffer; but if the region is active, START and END are +the start and end of the region. Print a message reporting the +number of lines, words, and chars. + +If called from Lisp, return the number of words between START and +END, without printing any message." + (interactive (list nil nil)) + (cond ((not (called-interactively-p 'any)) + (let ((words 0)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (forward-word 1) + (setq words (1+ words))))) + words)) + ((use-region-p) + (call-interactively 'count-words-region)) + (t + (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)) + (words (count-words start end)) + (chars (- end start))) + (message "%s has %d line%s, %d word%s, and %d character%s." + str + lines (if (= lines 1) "" "s") + words (if (= words 1) "" "s") + chars (if (= chars 1) "" "s")))) + +(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1") (defun what-line () "Print the current buffer line number and narrowed line number of point." @@ -1340,6 +1377,60 @@ to get different commands to edit and resubmit." "M-x ") obarray 'commandp t nil 'extended-command-history))) +(defcustom suggest-key-bindings t + "Non-nil means show the equivalent key-binding when M-x command has one. +The value can be a length of time to show the message for. +If the value is non-nil and not a number, we wait 2 seconds." + :group 'keyboard + :type '(choice (const :tag "off" nil) + (integer :tag "time" 2) + (other :tag "on"))) + +(defun execute-extended-command (prefixarg &optional command-name) + ;; Based on Fexecute_extended_command in keyboard.c of Emacs. + ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24 + "Read function name, then read its arguments and call it. + +To pass a numeric argument to the command you are invoking with, specify +the numeric argument to this command. + +Noninteractively, the argument PREFIXARG is the prefix argument to +give to the command you invoke, if it asks for an argument." + (interactive (list current-prefix-arg (read-extended-command))) + ;; Emacs<24 calling-convention was with a single `prefixarg' argument. + (if (null command-name) (setq command-name (read-extended-command))) + (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)))) + (unless (commandp function) + (error "`%s' is not a valid command name" command-name)) + (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. + (when binding + ;; But first wait, and skip the message if there is input. + (let* ((waited + ;; If this command displayed something in the echo area; + ;; wait a few seconds, then display our suggestion message. + (sit-for (cond + ((zerop (length (current-message))) 0) + ((numberp suggest-key-bindings) suggest-key-bindings) + (t 2))))) + (when (and waited (not (consp unread-command-events))) + (with-temp-message + (format "You can run the command `%s' with %s" + function (key-description binding)) + (sit-for (if (numberp suggest-key-bindings) + suggest-key-bindings + 2)))))))) (defvar minibuffer-history nil "Default minibuffer history list. @@ -1401,7 +1492,7 @@ See also `minibuffer-history-case-insensitive-variables'." (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) - (error "No previous history search regexp")) + (user-error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))) (unless (zerop n) @@ -1427,9 +1518,9 @@ See also `minibuffer-history-case-insensitive-variables'." (setq prevpos pos) (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history))) (when (= pos prevpos) - (error (if (= pos 1) - "No later matching history item" - "No earlier matching history item"))) + (user-error (if (= pos 1) + "No later matching history item" + "No earlier matching history item"))) (setq match-string (if (eq minibuffer-history-sexp-flag (minibuffer-depth)) (let ((print-level nil)) @@ -1472,7 +1563,7 @@ makes the search case-sensitive." (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) - (error "No previous history search regexp")) + (user-error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))) (previous-matching-history-element regexp (- n))) @@ -1531,11 +1622,11 @@ The argument NABS specifies the absolute history position." (setq minibuffer-text-before-history (minibuffer-contents-no-properties))) (if (< nabs minimum) - (if minibuffer-default - (error "End of defaults; no next item") - (error "End of history; no default available"))) + (user-error (if minibuffer-default + "End of defaults; no next item" + "End of history; no default available"))) (if (> nabs (length (symbol-value minibuffer-history-variable))) - (error "Beginning of history; no preceding item")) + (user-error "Beginning of history; no preceding item")) (unless (memq last-command '(next-history-element previous-history-element)) (let ((prompt-end (minibuffer-prompt-end))) @@ -1635,58 +1726,50 @@ Intended to be added to `minibuffer-setup-hook'." (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. @@ -1717,14 +1800,13 @@ Otherwise, it displays the standard isearch message returned from "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 () @@ -1773,9 +1855,13 @@ as an argument limits undo to changes within the current region." ;; 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'. @@ -1804,9 +1890,10 @@ as an argument limits undo to changes within the current region." ;; 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. @@ -1852,7 +1939,8 @@ as an argument limits undo to changes within the current region." ;; 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)))) @@ -1881,8 +1969,8 @@ Some change-hooks test this variable to do something different.") Call `undo-start' to get ready to undo recent changes, then call `undo-more' one or more times to undo them." (or (listp pending-undo-list) - (error (concat "No further undo information" - (and undo-in-region " for region")))) + (user-error (concat "No further undo information" + (and undo-in-region " for region")))) (let ((undo-in-progress t)) ;; Note: The following, while pulling elements off ;; `pending-undo-list' will call primitive change functions which @@ -1908,7 +1996,7 @@ If BEG and END are specified, then only undo elements that apply to text between BEG and END are used; other undo elements are ignored. If BEG and END are nil, all undo elements are used." (if (eq buffer-undo-list t) - (error "No undo information in this buffer")) + (user-error "No undo information in this buffer")) (setq pending-undo-list (if (and beg end (not (= beg end))) (undo-make-selective-list (min beg end) (max beg end)) @@ -2136,7 +2224,7 @@ of `history-length', which see.") "Switch used to have the shell execute its command line argument.") (defvar shell-command-default-error-buffer nil - "*Buffer name for `shell-command' and `shell-command-on-region' error output. + "Buffer name for `shell-command' and `shell-command-on-region' error output. This buffer is used when `shell-command' or `shell-command-on-region' is run interactively. A value of nil means that output to stderr and stdout will be intermixed in the output stream.") @@ -2187,12 +2275,41 @@ to `shell-command-history'." (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 @@ -2200,8 +2317,12 @@ shell (with its need to quote arguments)." (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) @@ -2212,9 +2333,10 @@ shell (with its need to quote arguments)." "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 @@ -2334,12 +2456,40 @@ the use of a shell (with its need to quote arguments)." 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 @@ -2450,12 +2600,10 @@ COMMAND. To specify a coding system for converting non-ASCII characters in the input and output to the shell command, use \\[universal-coding-system-argument] before this command. By default, the input (from the current buffer) -is encoded in the same coding system that will be used to save the file, -`buffer-file-coding-system'. If the output is going to replace the region, -then it is decoded from that same coding system. +is encoded using coding-system specified by `process-coding-system-alist', +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'. @@ -2463,34 +2611,34 @@ If the command generates output, the output may be displayed 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")) @@ -2663,13 +2811,13 @@ value passed." (defvar process-file-side-effects t "Whether a call of `process-file' changes remote files. -Per default, this variable is always set to `t', meaning that a +By default, this variable is always set to `t', meaning that a call of `process-file' could potentially change any file on a remote host. When set to `nil', a file handler could optimize -its behavior with respect to remote file attributes caching. +its behavior with respect to remote file attribute caching. -This variable should never be changed by `setq'. Instead of, it -shall be set only by let-binding.") +You should only ever change this variable with a let-binding; +never with `setq'.") (defun start-file-process (name buffer program &rest program-args) "Start a program in a subprocess. Return the process object for it. @@ -2713,47 +2861,52 @@ support pty association, if PROGRAM is nil." (tabulated-list-init-header)) (defun list-processes--refresh () - "Recompute the list of processes for the Process List buffer." + "Recompute the list of processes for the Process List buffer. +Also, delete any process that is exited or signaled." (setq tabulated-list-entries nil) (dolist (p (process-list)) - (when (or (not process-menu-query-only) - (process-query-on-exit-flag p)) - (let* ((buf (process-buffer p)) - (type (process-type p)) - (name (process-name p)) - (status (symbol-name (process-status p))) - (buf-label (if (buffer-live-p buf) - `(,(buffer-name buf) - face link - help-echo ,(concat "Visit buffer `" - (buffer-name buf) "'") - follow-link t - process-buffer ,buf - action process-menu-visit-buffer) - "--")) - (tty (or (process-tty-name p) "--")) - (cmd - (if (memq type '(network serial)) - (let ((contact (process-contact p t))) - (if (eq type 'network) - (format "(%s %s)" - (if (plist-get contact :type) - "datagram" - "network") - (if (plist-get contact :server) - (format "server on %s" - (plist-get contact :server)) - (format "connection to %s" - (plist-get contact :host)))) - (format "(serial port %s%s)" - (or (plist-get contact :port) "?") - (let ((speed (plist-get contact :speed))) - (if speed - (format " at %s b/s" speed) - ""))))) - (mapconcat 'identity (process-command p) " ")))) - (push (list p (vector name status buf-label tty cmd)) - tabulated-list-entries))))) + (cond ((memq (process-status p) '(exit signal closed)) + (delete-process p)) + ((or (not process-menu-query-only) + (process-query-on-exit-flag p)) + (let* ((buf (process-buffer p)) + (type (process-type p)) + (name (process-name p)) + (status (symbol-name (process-status p))) + (buf-label (if (buffer-live-p buf) + `(,(buffer-name buf) + face link + help-echo ,(concat "Visit buffer `" + (buffer-name buf) "'") + follow-link t + process-buffer ,buf + action process-menu-visit-buffer) + "--")) + (tty (or (process-tty-name p) "--")) + (cmd + (if (memq type '(network serial)) + (let ((contact (process-contact p t))) + (if (eq type 'network) + (format "(%s %s)" + (if (plist-get contact :type) + "datagram" + "network") + (if (plist-get contact :server) + (format "server on %s" + (or + (plist-get contact :host) + (plist-get contact :local))) + (format "connection to %s" + (plist-get contact :host)))) + (format "(serial port %s%s)" + (or (plist-get contact :port) "?") + (let ((speed (plist-get contact :speed))) + (if speed + (format " at %s b/s" speed) + ""))))) + (mapconcat 'identity (process-command p) " ")))) + (push (list p (vector name status buf-label tty cmd)) + tabulated-list-entries)))))) (defun process-menu-visit-buffer (button) (display-buffer (button-get button 'process-buffer))) @@ -2765,7 +2918,7 @@ the query-on-exit flag set are listed. 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) @@ -2914,28 +3067,46 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." (defvar filter-buffer-substring-functions nil - "Wrapper hook around `filter-buffer-substring'. -The functions on this special hook are called with four arguments: - NEXT-FUN BEG END DELETE -NEXT-FUN is a function of three arguments (BEG END DELETE) -that performs the default operation. The other three arguments -are like the ones passed to `filter-buffer-substring'.") + "This variable is a wrapper hook around `filter-buffer-substring'. +Each member of the hook should be a function accepting four arguments: +\(FUN BEG END DELETE), where FUN is itself a function of three arguments +\(BEG END DELETE). The arguments BEG, END, and DELETE are the same +as those of `filter-buffer-substring' in each case. + +The first hook function to be called receives a FUN equivalent +to the default operation of `filter-buffer-substring', +i.e. one that returns the buffer-substring between BEG and +END (processed by any `buffer-substring-filters'). Normally, +the hook function will call FUN and then do its own processing +of the result. The next hook function receives a FUN equivalent +to the previous hook function, calls it, and does its own +processing, and so on. The overall result is that of all hook +functions acting in sequence. + +Any hook may choose not to call FUN though, in which case it +effectively replaces the default behavior with whatever it chooses. +Of course, a later hook function may do the same thing.") (defvar buffer-substring-filters nil "List of filter functions for `filter-buffer-substring'. Each function must accept a single argument, a string, and return a string. The buffer substring is passed to the first function in the list, and the return value of each function is passed to -the next. The return value of the last function is used as the -return value of `filter-buffer-substring'. +the next. The final result (if `buffer-substring-filters' is +nil, this is the unfiltered buffer-substring) is passed to the +first function on `filter-buffer-substring-functions'. -If this variable is nil, no filtering is performed.") +As a special convention, point is set to the start of the buffer text +being operated on (i.e., the first argument of `filter-buffer-substring') +before these functions are called.") (make-obsolete-variable 'buffer-substring-filters 'filter-buffer-substring-functions "24.1") (defun filter-buffer-substring (beg end &optional delete) "Return the buffer substring between BEG and END, after filtering. -The filtering is performed by `filter-buffer-substring-functions'. +The wrapper hook `filter-buffer-substring-functions' performs +the actual filtering. The obsolete variable `buffer-substring-filters' +is also consulted. If both of these are nil, no filtering is done. If DELETE is non-nil, the text between BEG and END is deleted from the buffer. @@ -2964,41 +3135,43 @@ be copied into other buffers." (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.") @@ -3034,7 +3207,8 @@ before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]." :version "23.2") (defcustom kill-do-not-save-duplicates nil - "Do not add a new string to `kill-ring' when it is the same as the last one." + "Do not add a new string to `kill-ring' if it duplicates the last one. +The comparison is done using `equal-including-properties'." :type 'boolean :group 'killing :version "23.2") @@ -3062,7 +3236,10 @@ argument should still be a \"useful\" string for such uses." (signal 'args-out-of-range (list string "yank-handler specified for empty string")))) (unless (and kill-do-not-save-duplicates - (equal string (car kill-ring))) + ;; Due to text properties such as 'yank-handler that + ;; can alter the contents to yank, comparison using + ;; `equal' is unsafe. + (equal-including-properties string (car kill-ring))) (if (fboundp 'menu-bar-update-yank-menu) (menu-bar-update-yank-menu string (and replace (car kill-ring))))) (when save-interprogram-paste-before-kill @@ -3073,10 +3250,10 @@ argument should still be a \"useful\" string for such uses." (nreverse interprogram-paste) (list interprogram-paste))) (unless (and kill-do-not-save-duplicates - (equal s (car kill-ring))) + (equal-including-properties s (car kill-ring))) (push s kill-ring)))))) (unless (and kill-do-not-save-duplicates - (equal string (car kill-ring))) + (equal-including-properties string (car kill-ring))) (if (and replace kill-ring) (setcar kill-ring string) (push string kill-ring) @@ -3100,7 +3277,10 @@ If `interprogram-cut-function' is set, pass the resulting kill to it." (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") @@ -3155,10 +3335,6 @@ move the yanking point; just return the Nth kill forward." :type 'boolean :group 'killing) -(put 'text-read-only 'error-conditions - '(text-read-only buffer-read-only error)) -(put 'text-read-only 'error-message (purecopy "Text is read-only")) - (defun kill-region (beg end &optional yank-handler) "Kill (\"cut\") text between point and mark. This deletes the text from the buffer and saves it in the kill ring. @@ -3243,38 +3419,50 @@ 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) - ;; 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. @@ -3289,16 +3477,36 @@ The argument is used for internal purposes; do not supply one." ;; 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 @@ -3350,15 +3558,16 @@ doc string for `insert-for-yank-1', which see." (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") @@ -3435,8 +3644,10 @@ and KILLP is t if a prefix arg was specified." ((eq backward-delete-char-untabify-method 'all) " \t\n\r"))) (n (if skip - (let ((wh (- (point) (save-excursion (skip-chars-backward skip) - (point))))) + (let* ((oldpt (point)) + (wh (- oldpt (save-excursion + (skip-chars-backward skip) + (constrain-to-field nil oldpt))))) (+ arg (if (zerop wh) 0 (1- wh)))) arg))) ;; Avoid warning about delete-backward-char @@ -3446,20 +3657,20 @@ and KILLP is t if a prefix arg was specified." "Kill up to and including ARGth occurrence of CHAR. Case is ignored if `case-fold-search' is non-nil in the current buffer. Goes backward if ARG is negative; error if CHAR not found." - (interactive "p\ncZap to char: ") + (interactive (list (prefix-numeric-value current-prefix-arg) + (read-char "Zap to char: " t))) ;; Avoid "obsolete" warnings for translation-table-for-input. (with-no-warnings (if (char-table-p translation-table-for-input) (setq char (or (aref translation-table-for-input char) char)))) (kill-region (point) (progn (search-forward (char-to-string char) nil nil arg) -; (goto-char (if (> arg 0) (1- (point)) (1+ (point)))) (point)))) ;; 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) @@ -3647,7 +3858,8 @@ If ARG is zero, move to the beginning of the current line." (assq prop buffer-invisibility-spec)))))) (skip-chars-forward "^\n") (if (get-text-property (point) 'invisible) - (goto-char (next-single-property-change (point) 'invisible)) + (goto-char (or (next-single-property-change (point) 'invisible) + (point-max))) (goto-char (next-overlay-change (point)))) (end-of-line))) @@ -3751,10 +3963,18 @@ a mistake; see the documentation of `set-mark'." (signal 'mark-inactive nil))) (defsubst deactivate-mark (&optional force) - "Deactivate the mark by setting `mark-active' to nil. -Unless FORCE is non-nil, this function does nothing if Transient -Mark mode is disabled. -This function also runs `deactivate-mark-hook'." + "Deactivate the mark. +If Transient Mark mode is disabled, this function normally does +nothing; but if FORCE is non-nil, it deactivates the mark anyway. + +Deactivating the mark sets `mark-active' to nil, updates the +primary selection according to `select-active-regions', and runs +`deactivate-mark-hook'. + +If Transient Mark mode was temporarily enabled, reset the value +of the variable `transient-mark-mode'; if this causes Transient +Mark mode to be disabled, don't change `mark-active' to nil or +run `deactivate-mark-hook'." (when (or transient-mark-mode force) (when (and (if (eq select-active-regions 'only) (eq (car-safe transient-mark-mode) 'only) @@ -3767,11 +3987,14 @@ This function also runs `deactivate-mark-hook'." (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) @@ -4355,23 +4578,28 @@ lines." ;; a cleaner solution to the problem of making C-n do something ;; useful given a tall image. (defun line-move (arg &optional noerror to-end try-vscroll) - (unless (and auto-window-vscroll try-vscroll - ;; Only vscroll for single line moves - (= (abs arg) 1) - ;; But don't vscroll in a keyboard macro. - (not defining-kbd-macro) - (not executing-kbd-macro) - (line-move-partial arg noerror to-end)) - (set-window-vscroll nil 0 t) - (if (and line-move-visual - ;; Display-based column are incompatible with goal-column. - (not goal-column) - ;; 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))) - (line-move-visual arg noerror) - (line-move-1 arg noerror to-end)))) + (if noninteractive + (forward-line arg) + (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) + (line-move-partial arg noerror to-end)) + (set-window-vscroll nil 0 t) + (if (and line-move-visual + ;; Display-based column are incompatible with goal-column. + (not goal-column) + ;; 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))) + (line-move-visual arg noerror) + (line-move-1 arg noerror to-end))))) ;; Display-based alternative to line-move-1. ;; Arg says how many lines to move. The value is t if we can move the @@ -5271,7 +5499,7 @@ Returns t if it really did any work." t))) (defvar comment-line-break-function 'comment-indent-new-line - "*Mode-specific function which line breaks and continues a comment. + "Mode-specific function which line breaks and continues a comment. This function is called during auto-filling when a comment syntax is defined. The function should take a single optional argument, which is a flag @@ -5332,7 +5560,9 @@ non-`nil'. 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 () @@ -5445,7 +5675,8 @@ the line. Before a tab, such characters insert until the tab is 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. @@ -5464,7 +5695,8 @@ ordinary typing characters do. 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). @@ -5779,8 +6011,8 @@ Valid values include: `mh-e-user-agent' -- use the Emacs interface to the MH mail system. See Info node `(mh-e)'. `gnus-user-agent' -- like `message-user-agent', but with Gnus - paraphernalia, particularly the Gcc: header for - archiving. + paraphernalia if Gnus is running, particularly + the Gcc: header for archiving. Additional valid symbols may be available; check with the author of your package for details. The function should return non-nil if it @@ -5933,7 +6165,7 @@ in the definition is used to check that VALUE is valid. With a prefix argument, set VARIABLE to VALUE buffer-locally." (interactive (let* ((default-var (variable-at-point)) - (var (if (user-variable-p default-var) + (var (if (custom-variable-p default-var) (read-variable (format "Set variable (default %s): " default-var) default-var) (read-variable "Set variable: "))) @@ -6109,21 +6341,11 @@ With prefix argument N, move N items (negative N means move backward)." (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 @@ -6161,9 +6383,8 @@ With prefix argument N, move N items (negative N means move backward)." (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. @@ -6260,7 +6481,7 @@ Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\ "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) @@ -6654,7 +6875,7 @@ call `normal-erase-is-backspace-mode' (which see) instead." (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)) @@ -6697,8 +6918,10 @@ probably not turn on this mode on a text-only terminal if you don't 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)))) @@ -6743,6 +6966,32 @@ See also `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 |