Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca

[bpt/emacs.git] / lisp / simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 655298e..19140cb 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,6 +1,6 @@
 ;;; simple.el --- basic editing commands for Emacs
 
 ;;; 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
 
 ;; Maintainer: FSF
 ;; Keywords: internal


@@ -28,8 +28,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))       ;For define-minor-mode.
-

 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
 


@@ -367,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 ">" '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)
     map))
 
 (put 'special-mode 'mode-class 'special)


@@ -566,13 +563,28 @@ On nonblank line, delete any immediately following blank lines."
     (if (looking-at "^[ \t]*\n\\'")
        (delete-region (point) (point-max)))))
 
     (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)
 (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)
   (interactive (progn
                  (barf-if-buffer-read-only)
                  (if (use-region-p)


@@ -592,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 empty lines.
         (goto-char end-marker)
         (when (and (not end)

+                  delete-trailing-lines

                    ;; Really the end of buffer.
                    ;; 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))))
                    (<= (skip-chars-backward "\n") -2))
           (delete-region (1+ (point)) end-marker))
         (set-marker end-marker nil))))


@@ -731,7 +744,7 @@ If BACKWARD-ONLY is non-nil, only delete them before point."
 
 (defun just-one-space (&optional n)
   "Delete all spaces and tabs around point, leaving one space (or N spaces).
 
 (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))
   (interactive "*p")
   (unless n (setq n 1))
   (let ((orig-pos (point))


@@ -934,11 +947,8 @@ rather than line counts."
                 (concat " in " (buffer-name buffer))
               "")))
        ;; Read the argument, offering that number (if any) as default.
                 (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
             buffer))))
   ;; Switch to the desired buffer, one way or another.
   (if buffer


@@ -955,16 +965,24 @@ rather than line counts."
        (re-search-forward "[\n\C-m]" nil 'end (1- line))
       (forward-line (1- line)))))
 
        (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
   "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."
 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.
 
 (defun count-words (start end)
   "Count words between START and END.


@@ -988,7 +1006,12 @@ END, without printing any message."
        ((use-region-p)
         (call-interactively 'count-words-region))
        (t
        ((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))
 
 (defun count-words--message (str start end)
   (let ((lines (count-lines start end))


@@ -1832,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.
   ;; 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'.
     ;; 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'.


@@ -1863,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))
     ;; 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.
       (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.


@@ -1911,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))
     ;; 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))))
     ;; Display a message announcing success.
     (if message
        (message "%s" message))))


@@ -2246,12 +2275,41 @@ to `shell-command-history'."
           (or hist 'shell-command-history)
           args)))
 
           (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.
 
 (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*'.
 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
 
 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


@@ -2259,8 +2317,12 @@ shell (with its need to quote arguments)."
   (interactive
    (list
     (read-shell-command "Async shell command: " nil nil
   (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)
     current-prefix-arg
     shell-command-default-error-buffer))
   (unless (string-match "&[ \t]*\\'" command)


@@ -2271,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.
 
   "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*'.
 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
 
 Otherwise, COMMAND is executed synchronously.  The output appears in
 the buffer `*Shell Command Output*'.  If the output is short enough to


@@ -2393,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)))
                    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))
                (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")))
                        (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
                (with-current-buffer buffer
                  (setq buffer-read-only nil)
                  ;; Setting buffer-read-only to nil doesn't suffice


@@ -2513,8 +2604,6 @@ 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'.
 
 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'.
 
 Noninteractive callers can specify coding systems by binding
 `coding-system-for-read' and `coding-system-for-write'.
 


@@ -2522,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
 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
 
 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.
 
 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"))
   (interactive (let (string)
                 (unless (mark)
                   (error "The mark is not set now, so there is no region"))


@@ -2715,7 +2804,7 @@ value passed."
                      (or lc infile)
                      (if stderr-file (list (car buffer) stderr-file) buffer)
                      display args)
                      (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)))))
 
       (when stderr-file (delete-file stderr-file))
       (when lc (delete-file lc)))))
 


@@ -2804,7 +2893,9 @@ Also, delete any process that is exited or signaled."
                                       "network")
                                     (if (plist-get contact :server)
                                         (format "server on %s"
                                       "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)"
                                       (format "connection to %s"
                                               (plist-get contact :host))))
                           (format "(serial port %s%s)"


@@ -2827,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
 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)
 The return value is always nil."
   (interactive)
   (or (fboundp 'process-list)


@@ -3044,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.
 
 (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.
 
 (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
 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
 
 
 \f
 
 


@@ -3184,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
 (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")
   :type 'boolean
   :group 'killing
   :version "23.1")


@@ -3274,6 +3370,7 @@ to make one entry in the kill ring."
            (kill-new string nil yank-handler)))
        (when (or string (eq last-command 'kill-region))
          (setq this-command 'kill-region))
            (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
        nil)
     ((buffer-read-only text-read-only)
      ;; The code above failed because the buffer, or some of the characters


@@ -3323,38 +3420,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)
 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)
   (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.
 
 (defun append-next-kill (&optional interactive)
   "Cause following command, if it kills, to append to previous kill.


@@ -3369,16 +3478,36 @@ The argument is used for internal purposes; do not supply one."
 \f
 ;; Yanking.
 
 \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
 ;; 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,
   "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
   :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
 
 (defvar yank-window-start nil)
 (defvar yank-undo-function nil


@@ -3430,15 +3559,16 @@ doc string for `insert-for-yank-1', which see."
 
 (defun yank (&optional arg)
   "Reinsert (\"paste\") the last stretch of killed text.
 
 (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")
 
 See also the command `yank-pop' (\\[yank-pop])."
   (interactive "*P")


@@ -3541,7 +3671,7 @@ Goes backward if ARG is negative; error if CHAR not found."
 ;; kill-line and its subroutines.
 
 (defcustom kill-whole-line nil
 ;; 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)
 
   :type 'boolean
   :group 'killing)
 


@@ -3858,11 +3988,14 @@ run `deactivate-mark-hook'."
       (cond (saved-region-selection
             (x-set-selection 'PRIMARY saved-region-selection)
             (setq saved-region-selection nil))
       (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
             (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)
     (if (and (null force)
             (or (eq transient-mark-mode 'lambda)
                 (and (eq (car-safe transient-mark-mode) 'only)


@@ -3880,7 +4013,8 @@ run `deactivate-mark-hook'."
   (when (mark t)
     (setq mark-active t)
     (unless transient-mark-mode
   (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!
 
 (defun set-mark (pos)
   "Set this buffer's mark to POS.  Don't use this function!


@@ -4001,14 +4135,6 @@ after C-u \\[set-mark-command]."
   :type 'boolean
   :group 'editing-basics)
 
   :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
 (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


@@ -4070,8 +4196,7 @@ purposes.  See the documentation of `set-mark' for more information."
       (activate-mark)
       (message "Mark activated")))
    (t
       (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.
 
 (defun push-mark (&optional location nomsg activate)
   "Set mark at LOCATION (point, by default) and push old mark on mark ring.


@@ -4135,7 +4260,6 @@ mode temporarily."
     (deactivate-mark)
     (set-mark (point))
     (goto-char omark)
     (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)))
     (cond (temp-highlight
           (setq transient-mark-mode (cons 'only transient-mark-mode)))
          ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))


@@ -4200,14 +4324,14 @@ else--for example, incremental search, \\[beginning-of-buffer], and \\[end-of-bu
 You can also deactivate the mark by typing \\[keyboard-quit] or
 \\[keyboard-escape-quit].
 
 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].
 \\[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)
   :global t
   ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
   :variable transient-mark-mode)


@@ -4451,6 +4575,9 @@ lines."
     (unless (and auto-window-vscroll try-vscroll
                 ;; Only vscroll for single line moves
                 (= (abs arg) 1)
     (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)
                 ;; But don't vscroll in a keyboard macro.
                 (not defining-kbd-macro)
                 (not executing-kbd-macro)


@@ -5173,14 +5300,21 @@ current object."
       (setq pos1 pos2 pos2 swap)))
   (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
   (atomic-change-group
       (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.
 \f
 (defun backward-word (&optional arg)
   "Move backward until encountering the beginning of a word.


@@ -5425,7 +5559,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."
 
 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 ()
 
 ;; This holds a document string used to document auto-fill-mode.
 (defun auto-fill-function ()


@@ -5538,7 +5674,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."
 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.
 
 (define-minor-mode binary-overwrite-mode
   "Toggle Binary Overwrite mode.


@@ -5557,7 +5694,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'."
 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).
 
 (define-minor-mode line-number-mode
   "Toggle line number display in the mode line (Line Number mode).


@@ -6244,9 +6382,8 @@ With prefix argument N, move N items (negative N means move backward)."
       (point))))
 
 (defun choose-completion-delete-max-match (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)))
   (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.
 
 (defvar choose-completion-string-functions nil
   "Functions that may override the normal insertion of a completion choice.


@@ -6343,7 +6480,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)
   "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)
 
 
 (add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
 


@@ -6737,7 +6874,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))
        (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))
                         (and (memq window-system '(x))
                              (fboundp 'x-backspace-delete-keys-p)
                              (x-backspace-delete-keys-p))


@@ -6780,8 +6917,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'."
 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))))
 
   (let ((enabled (eq 1 (terminal-parameter
                         nil 'normal-erase-is-backspace))))
 


@@ -6826,6 +6965,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.")
 
 (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
 (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