X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/11af46027d22daa11d0df7d5032e6925c990dad1..34a43ba26a049bb966426022ffb2c41ab07841b8:/lisp/simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 76f307fec8..46023a575f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,6 +1,6 @@
 ;;; simple.el --- basic editing commands for Emacs  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1987, 1993-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2015 Free Software Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
@@ -28,6 +28,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl-lib))
+
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
 
@@ -410,6 +412,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
           ;; Do the rest in post-self-insert-hook, because we want to do it
           ;; *before* other functions on that hook.
           (lambda ()
+            (cl-assert (eq ?\n (char-before)))
             ;; Mark the newline(s) `hard'.
             (if use-hard-newlines
                 (set-hard-newline-properties
@@ -428,7 +431,8 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
             ;; starts a page.
             (or was-page-start
                 (move-to-left-margin nil t)))))
-    (if (not interactive)
+    (unwind-protect
+        (if (not interactive)
         ;; FIXME: For non-interactive uses, many calls actually just want
         ;; (insert "\n"), so maybe we should do just that, so as to avoid
         ;; the risk of filling or running abbrevs unexpectedly.
@@ -436,12 +440,14 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
           (self-insert-command (prefix-numeric-value arg)))
       (unwind-protect
           (progn
-            (add-hook 'post-self-insert-hook postproc)
+            (add-hook 'post-self-insert-hook postproc nil t)
             (self-insert-command (prefix-numeric-value arg)))
         ;; We first used let-binding to protect the hook, but that was naive
         ;; since add-hook affects the symbol-default value of the variable,
         ;; whereas the let-binding might only protect the buffer-local value.
-        (remove-hook 'post-self-insert-hook postproc))))
+        (remove-hook 'post-self-insert-hook postproc t)))
+      (cl-assert (not (member postproc post-self-insert-hook)))
+      (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
   nil)
 
 (defun set-hard-newline-properties (from to)
@@ -1223,15 +1229,21 @@ in *Help* buffer.  See also the command `describe-char'."
   (interactive "P")
   (let* ((char (following-char))
 	 (bidi-fixer
-	  (cond ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e))
-		 ;; If the character is one of LRE, LRO, RLE, RLO, it
-		 ;; will start a directional embedding, which could
-		 ;; completely disrupt the rest of the line (e.g., RLO
-		 ;; will display the rest of the line right-to-left).
-		 ;; So we put an invisible PDF character after these
-		 ;; characters, to end the embedding, which eliminates
-		 ;; any effects on the rest of the line.
+	  ;; If the character is one of LRE, LRO, RLE, RLO, it will
+	  ;; start a directional embedding, which could completely
+	  ;; disrupt the rest of the line (e.g., RLO will display the
+	  ;; rest of the line right-to-left).  So we put an invisible
+	  ;; PDF character after these characters, to end the
+	  ;; embedding, which eliminates any effects on the rest of
+	  ;; the line.  For RLE and RLO we also append an invisible
+	  ;; LRM, to avoid reordering the following numerical
+	  ;; characters.  For LRI/RLI/FSI we append a PDI.
+	  (cond ((memq char '(?\x202a ?\x202d))
 		 (propertize (string ?\x202c) 'invisible t))
+		((memq char '(?\x202b ?\x202e))
+		 (propertize (string ?\x202c ?\x200e) 'invisible t))
+		((memq char '(?\x2066 ?\x2067 ?\x2068))
+		 (propertize (string ?\x2069) 'invisible t))
 		;; Strong right-to-left characters cause reordering of
 		;; the following numerical characters which show the
 		;; codepoint, so append LRM to countermand that.
@@ -1394,8 +1406,11 @@ display the result of expression evaluation."
   (let ((minibuffer-completing-symbol t))
     (minibuffer-with-setup-hook
         (lambda ()
+          ;; FIXME: call emacs-lisp-mode?
+          (add-function :before-until (local 'eldoc-documentation-function)
+                        #'elisp-eldoc-documentation-function)
           (add-hook 'completion-at-point-functions
-                    #'lisp-completion-at-point nil t)
+                    #'elisp-completion-at-point nil t)
           (run-hooks 'eval-expression-minibuffer-setup-hook))
       (read-from-minibuffer prompt initial-contents
                             read-expression-map t
@@ -1433,7 +1448,7 @@ this command arranges for all errors to enter the debugger."
       ;; Bind debug-on-error to something unique so that we can
       ;; detect when evalled code changes it.
       (let ((debug-on-error old-value))
-	(push (eval exp lexical-binding) values)
+	(push (eval (macroexpand-all exp) lexical-binding) values)
 	(setq new-value debug-on-error))
       ;; If evalled code has changed the value of debug-on-error,
       ;; propagate that change to the global binding.
@@ -1524,11 +1539,17 @@ to get different commands to edit and resubmit."
 
 
 (defvar extended-command-history nil)
+(defvar execute-extended-command--last-typed nil)
 
 (defun read-extended-command ()
   "Read command name to invoke in `execute-extended-command'."
   (minibuffer-with-setup-hook
       (lambda ()
+        (add-hook 'post-self-insert-hook
+                  (lambda ()
+                    (setq execute-extended-command--last-typed
+                              (minibuffer-contents)))
+                  nil 'local)
 	(set (make-local-variable 'minibuffer-default-add-function)
 	     (lambda ()
 	       ;; Get a command name at point in the original buffer
@@ -1556,7 +1577,17 @@ to get different commands to edit and resubmit."
 	     ;; because "M-x" is a well-known prompt to read a command
 	     ;; and it serves as a shorthand for "Extended command: ".
 	     "M-x ")
-     obarray 'commandp t nil 'extended-command-history)))
+     (lambda (string pred action)
+       (let ((pred
+              (if (memq action '(nil t))
+                  ;; Exclude obsolete commands from completions.
+                  (lambda (sym)
+                    (and (funcall pred sym)
+                         (or (equal string (symbol-name sym))
+                             (not (get sym 'byte-obsolete-info)))))
+                pred)))
+         (complete-with-action action obarray string pred)))
+     #'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.
@@ -1567,19 +1598,59 @@ If the value is non-nil and not a number, we wait 2 seconds."
                  (integer :tag "time" 2)
                  (other :tag "on")))
 
-(defun execute-extended-command (prefixarg &optional command-name)
+(defun execute-extended-command--shorter-1 (name length)
+  (cond
+   ((zerop length) (list ""))
+   ((equal name "") nil)
+   (t
+    (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
+                   (execute-extended-command--shorter-1
+                    (substring name 1) (1- length)))
+           (when (string-match "\\`\\(-\\)?[^-]*" name)
+             (execute-extended-command--shorter-1
+              (substring name (match-end 0)) length))))))
+
+(defun execute-extended-command--shorter (name typed)
+  (let ((candidates '())
+        (max (length typed))
+        (len 1)
+        binding)
+    (while (and (not binding)
+                (progn
+                  (unless candidates
+                    (setq len (1+ len))
+                    (setq candidates (execute-extended-command--shorter-1
+                                      name len)))
+                  ;; Don't show the help message if the binding isn't
+                  ;; significantly shorter than the M-x command the user typed.
+                  (< len (- max 5))))
+      (let ((candidate (pop candidates)))
+        (when (equal name
+                       (car-safe (completion-try-completion
+                                  candidate obarray 'commandp len)))
+          (setq binding candidate))))
+    binding))
+
+(defun execute-extended-command (prefixarg &optional command-name typed)
   ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
   ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
   "Read a command name, then read the arguments and call the command.
-Interactively, to pass a prefix argument to the command you are
-invoking, give a prefix argument to `execute-extended-command'.
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke."
-  (interactive (list current-prefix-arg (read-extended-command)))
+To pass a prefix argument to the command you are
+invoking, give a prefix argument to `execute-extended-command'."
+  (declare (interactive-only command-execute))
+  ;; FIXME: Remember the actual text typed by the user before completion,
+  ;; so that we don't later on suggest the same shortening.
+  (interactive
+   (let ((execute-extended-command--last-typed nil))
+     (list current-prefix-arg
+           (read-extended-command)
+           execute-extended-command--last-typed)))
   ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
-  (if (null command-name)
-      (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
-                           (read-extended-command))))
+  (unless command-name
+    (let ((current-prefix-arg prefixarg) ; for prompt
+          (execute-extended-command--last-typed nil))
+      (setq command-name (read-extended-command))
+      (setq typed execute-extended-command--last-typed)))
   (let* ((function (and (stringp command-name) (intern-soft command-name)))
          (binding (and suggest-key-bindings
 		       (not executing-kbd-macro)
@@ -1596,19 +1667,34 @@ give to the command you invoke."
     (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.
+    ;; 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.
+            ;; FIXME: Wait *after* running post-command-hook!
+            ;; FIXME: Don't wait if execute-extended-command--shorter won't
+            ;; find a better answer anyway!
+            (when suggest-key-bindings
               (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)))
+                        (t 2))))))
+      (when (and waited (not (consp unread-command-events)))
+        (unless (or binding executing-kbd-macro (not (symbolp function))
+                    (<= (length (symbol-name function)) 2))
+          ;; There's no binding for CMD.  Let's try and find the shortest
+          ;; string to use in M-x.
+          ;; FIXME: Can be slow.  Cache it maybe?
+          (while-no-input
+            (setq binding (execute-extended-command--shorter
+                           (symbol-name function) typed))))
+        (when binding
           (with-temp-message
               (format "You can run the command `%s' with %s"
-                      function (key-description binding))
+                      function
+                      (if (stringp binding)
+                          (concat "M-x " binding " RET")
+                        (key-description binding)))
             (sit-for (if (numberp suggest-key-bindings)
                          suggest-key-bindings
                        2))))))))
@@ -1690,6 +1776,7 @@ in this use of the minibuffer.")
 
 (defun minibuffer-avoid-prompt (_new _old)
   "A point-motion hook for the minibuffer, that moves point out of the prompt."
+  (declare (obsolete cursor-intangible-mode "25.1"))
   (constrain-to-field nil (point-max)))
 
 (defcustom minibuffer-history-case-insensitive-variables nil
@@ -1854,7 +1941,9 @@ The argument NABS specifies the absolute history position."
 	(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)))
+    (if (> nabs (if (listp (symbol-value minibuffer-history-variable))
+                    (length (symbol-value minibuffer-history-variable))
+                  0))
 	(user-error "Beginning of history; no preceding item"))
     (unless (memq last-command '(next-history-element
 				 previous-history-element))
@@ -1898,6 +1987,67 @@ With argument N, it uses the Nth previous element."
   (or (zerop n)
       (goto-history-element (+ minibuffer-history-position n))))
 
+(defun next-line-or-history-element (&optional arg)
+  "Move cursor vertically down ARG lines, or to the next history element.
+When point moves over the bottom line of multi-line minibuffer, puts ARGth
+next element of the minibuffer history in the minibuffer."
+  (interactive "^p")
+  (or arg (setq arg 1))
+  (let* ((old-point (point))
+	 ;; Remember the original goal column of possibly multi-line input
+	 ;; excluding the length of the prompt on the first line.
+	 (prompt-end (minibuffer-prompt-end))
+	 (old-column (unless (and (eolp) (> (point) prompt-end))
+		       (if (= (line-number-at-pos) 1)
+			   (max (- (current-column) (1- prompt-end)) 0)
+			 (current-column)))))
+    (condition-case nil
+	(with-no-warnings
+	  (next-line arg))
+      (end-of-buffer
+       ;; Restore old position since `line-move-visual' moves point to
+       ;; the end of the line when it fails to go to the next line.
+       (goto-char old-point)
+       (next-history-element arg)
+       ;; Restore the original goal column on the last line
+       ;; of possibly multi-line input.
+       (goto-char (point-max))
+       (when old-column
+	 (if (= (line-number-at-pos) 1)
+	     (move-to-column (+ old-column (1- (minibuffer-prompt-end))))
+	   (move-to-column old-column)))))))
+
+(defun previous-line-or-history-element (&optional arg)
+  "Move cursor vertically up ARG lines, or to the previous history element.
+When point moves over the top line of multi-line minibuffer, puts ARGth
+previous element of the minibuffer history in the minibuffer."
+  (interactive "^p")
+  (or arg (setq arg 1))
+  (let* ((old-point (point))
+	 ;; Remember the original goal column of possibly multi-line input
+	 ;; excluding the length of the prompt on the first line.
+	 (prompt-end (minibuffer-prompt-end))
+	 (old-column (unless (and (eolp) (> (point) prompt-end))
+		       (if (= (line-number-at-pos) 1)
+			   (max (- (current-column) (1- prompt-end)) 0)
+			 (current-column)))))
+    (condition-case nil
+	(with-no-warnings
+	  (previous-line arg))
+      (beginning-of-buffer
+       ;; Restore old position since `line-move-visual' moves point to
+       ;; the beginning of the line when it fails to go to the previous line.
+       (goto-char old-point)
+       (previous-history-element arg)
+       ;; Restore the original goal column on the first line
+       ;; of possibly multi-line input.
+       (goto-char (minibuffer-prompt-end))
+       (if old-column
+	   (if (= (line-number-at-pos) 1)
+	       (move-to-column (+ old-column (1- (minibuffer-prompt-end))))
+	     (move-to-column old-column))
+	 (goto-char (line-end-position)))))))
+
 (defun next-complete-history-element (n)
   "Get next history element which completes the minibuffer before the point.
 The contents of the minibuffer after the point are deleted, and replaced
@@ -2512,6 +2662,7 @@ marker adjustment's corresponding (TEXT . POS) element."
   "Test whether UNDO-ELT crosses one edge of that region START ... END.
 This assumes we have already decided that UNDO-ELT
 is not *inside* the region START...END."
+  (declare (obsolete nil "25.1"))
   (cond ((atom undo-elt) nil)
 	((null (car undo-elt))
 	 ;; (nil PROPERTY VALUE BEG . END)
@@ -2522,7 +2673,6 @@ is not *inside* the region START...END."
 	 ;; (BEGIN . END)
 	 (and (< (car undo-elt) end)
 	      (> (cdr undo-elt) start)))))
-(make-obsolete 'undo-elt-crosses-region nil "24.5")
 
 (defun undo-adjust-elt (elt deltas)
   "Return adjustment of undo element ELT by the undo DELTAS
@@ -2678,7 +2828,7 @@ which is defined in the `warnings' library.\n")
     t))
 
 (defcustom password-word-equivalents
-  '("password" "passphrase" "pass phrase"
+  '("password" "passcode" "passphrase" "pass phrase"
     ; These are sorted according to the GNU en_US locale.
     "암호"		; ko
     "パスワード"	; ja
@@ -2993,12 +3143,14 @@ the use of a shell (with its need to quote arguments)."
 		    ;; 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*")))
+				      (or (and (bufferp output-buffer) (buffer-name output-buffer))
+					  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*"))))
+				  (or (and (bufferp output-buffer) (buffer-name output-buffer))
+				      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? ")
@@ -3336,9 +3488,9 @@ value passed."
 (defvar process-file-side-effects t
   "Whether a call of `process-file' changes remote files.
 
-By 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
+remote host.  When set to nil, a file handler could optimize
 its behavior with respect to remote file attribute caching.
 
 You should only ever change this variable with a let-binding;
@@ -3626,7 +3778,7 @@ No filtering is done unless a hook says to."
 
 ;;;; Window system cut and paste hooks.
 
-(defvar interprogram-cut-function nil
+(defvar interprogram-cut-function #'gui-select-text
   "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
@@ -3637,7 +3789,7 @@ 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
+(defvar interprogram-paste-function #'gui-selection-value
   "Function to call to get text cut from other programs.
 Most window systems provide a facility for cutting and pasting
 text between different programs, such as the clipboard on X and
@@ -3755,7 +3907,7 @@ argument should still be a \"useful\" string for such uses."
   "Whether appending to kill ring also makes \\[undo] restore both pieces of text simultaneously."
   :type 'boolean
   :group 'killing
-  :version "24.5")
+  :version "25.1")
 
 (defun kill-append (string before-p)
   "Append STRING to the end of the latest kill in the kill ring.
@@ -3865,7 +4017,7 @@ some text between BEG and END, but we're killing the region."
   ;; calling `kill-append'.
   (interactive (list (mark) (point) 'region))
   (unless (and beg end)
-    (error "The mark is not set now, so there is no region"))
+    (user-error "The mark is not set now, so there is no region"))
   (condition-case nil
       (let ((string (if region
                         (funcall region-extract-function 'delete)
@@ -3975,7 +4127,7 @@ of this sample text; it defaults to 40."
 	  (goto-char point)
 	  ;; If user quit, deactivate the mark
 	  ;; as C-g would as a command.
-	  (and quit-flag mark-active
+	  (and quit-flag (region-active-p)
 	       (deactivate-mark)))
       (let ((len (min (abs (- mark point))
 		      (or message-len 40))))
@@ -4006,6 +4158,144 @@ The argument is used for internal purposes; do not supply one."
 	(setq this-command 'kill-region)
 	(message "If the next command is a kill, it will append"))
     (setq last-command 'kill-region)))
+
+(defvar bidi-directional-controls-chars "\x202a-\x202e\x2066-\x2069"
+  "Character set that matches bidirectional formatting control characters.")
+
+(defvar bidi-directional-non-controls-chars "^\x202a-\x202e\x2066-\x2069"
+  "Character set that matches any character except bidirectional controls.")
+
+(defun squeeze-bidi-context-1 (from to category replacement)
+  "A subroutine of `squeeze-bidi-context'.
+FROM and TO should be markers, CATEGORY and REPLACEMENT should be strings."
+  (let ((pt (copy-marker from))
+	(limit (copy-marker to))
+	(old-pt 0)
+	lim1)
+    (setq lim1 limit)
+    (goto-char pt)
+    (while (< pt limit)
+      (if (> pt old-pt)
+	  (move-marker lim1
+		       (save-excursion
+			 ;; L and R categories include embedding and
+			 ;; override controls, but we don't want to
+			 ;; replace them, because that might change
+			 ;; the visual order.  Likewise with PDF and
+			 ;; isolate controls.
+			 (+ pt (skip-chars-forward
+				bidi-directional-non-controls-chars
+				limit)))))
+      ;; Replace any run of non-RTL characters by a single LRM.
+      (if (null (re-search-forward category lim1 t))
+	  ;; No more characters of CATEGORY, we are done.
+	  (setq pt limit)
+	(replace-match replacement nil t)
+	(move-marker pt (point)))
+      (setq old-pt pt)
+      ;; Skip directional controls, if any.
+      (move-marker
+       pt (+ pt (skip-chars-forward bidi-directional-controls-chars limit))))))
+
+(defun squeeze-bidi-context (from to)
+  "Replace characters between FROM and TO while keeping bidi context.
+
+This function replaces the region of text with as few characters
+as possible, while preserving the effect that region will have on
+bidirectional display before and after the region."
+  (let ((start (set-marker (make-marker)
+			   (if (> from 0) from (+ (point-max) from))))
+	(end (set-marker (make-marker) to))
+	;; This is for when they copy text with read-only text
+	;; properties.
+	(inhibit-read-only t))
+    (if (null (marker-position end))
+	(setq end (point-max-marker)))
+    ;; Replace each run of non-RTL characters with a single LRM.
+    (squeeze-bidi-context-1 start end "\\CR+" "\x200e")
+    ;; Replace each run of non-LTR characters with a single RLM.  Note
+    ;; that the \cR category includes both the Arabic Letter (AL) and
+    ;; R characters; here we ignore the distinction between them,
+    ;; because that distinction only affects Arabic Number (AN)
+    ;; characters, which are weak and don't affect the reordering.
+    (squeeze-bidi-context-1 start end "\\CL+" "\x200f")))
+
+(defun line-substring-with-bidi-context (start end &optional no-properties)
+  "Return buffer text between START and END with its bidi context.
+
+START and END are assumed to belong to the same physical line
+of buffer text.  This function prepends and appends to the text
+between START and END bidi control characters that preserve the
+visual order of that text when it is inserted at some other place."
+  (if (or (< start (point-min))
+	  (> end (point-max)))
+      (signal 'args-out-of-range (list (current-buffer) start end)))
+  (let ((buf (current-buffer))
+	substr para-dir from to)
+    (save-excursion
+      (goto-char start)
+      (setq para-dir (current-bidi-paragraph-direction))
+      (setq from (line-beginning-position)
+	    to (line-end-position))
+      (goto-char from)
+      ;; If we don't have any mixed directional characters in the
+      ;; entire line, we can just copy the substring without adding
+      ;; any context.
+      (if (or (looking-at-p "\\CR*$")
+	      (looking-at-p "\\CL*$"))
+	  (setq substr (if no-properties
+			   (buffer-substring-no-properties start end)
+			 (buffer-substring start end)))
+	(setq substr
+	      (with-temp-buffer
+		(if no-properties
+		    (insert-buffer-substring-no-properties buf from to)
+		  (insert-buffer-substring buf from to))
+		(squeeze-bidi-context 1 (1+ (- start from)))
+		(squeeze-bidi-context (- end to) nil)
+		(buffer-substring 1 (point-max)))))
+
+      ;; Wrap the string in LRI/RLI..PDI pair to achieve 2 effects:
+      ;; (1) force the string to have the same base embedding
+      ;; direction as the paragraph direction at the source, no matter
+      ;; what is the paragraph direction at destination; and (2) avoid
+      ;; affecting the visual order of the surrounding text at
+      ;; destination if there are characters of different
+      ;; directionality there.
+      (concat (if (eq para-dir 'left-to-right) "\x2066" "\x2067")
+	      substr "\x2069"))))
+
+(defun buffer-substring-with-bidi-context (start end &optional no-properties)
+  "Return portion of current buffer between START and END with bidi context.
+
+This function works similar to `buffer-substring', but it prepends and
+appends to the text bidi directional control characters necessary to
+preserve the visual appearance of the text if it is inserted at another
+place.  This is useful when the buffer substring includes bidirectional
+text and control characters that cause non-trivial reordering on display.
+If copied verbatim, such text can have a very different visual appearance,
+and can also change the visual appearance of the surrounding text at the
+destination of the copy.
+
+Optional argument NO-PROPERTIES, if non-nil, means copy the text without
+the text properties."
+  (let (line-end substr)
+    (if (or (< start (point-min))
+	    (> end (point-max)))
+	(signal 'args-out-of-range (list (current-buffer) start end)))
+    (save-excursion
+      (goto-char start)
+      (setq line-end (min end (line-end-position)))
+      (while (< start end)
+	(setq substr
+	      (concat substr
+		      (if substr "\n" "")
+		      (line-substring-with-bidi-context start line-end
+							no-properties)))
+	(forward-line 1)
+	(setq start (point))
+	(setq line-end (min end (line-end-position))))
+      substr)))
 
 ;; Yanking.
 
@@ -4068,7 +4358,7 @@ When this command inserts killed text into the buffer, it honors
 doc string for `insert-for-yank-1', which see."
   (interactive "*p")
   (if (not (eq last-command 'yank))
-      (error "Previous command was not a yank"))
+      (user-error "Previous command was not a yank"))
   (setq this-command 'yank)
   (unless arg (setq arg 1))
   (let ((inhibit-read-only t)
@@ -4494,10 +4784,6 @@ a mistake; see the documentation of `set-mark'."
     (signal 'mark-inactive nil)))
 
 ;; Behind display-selections-p.
-(declare-function x-selection-owner-p "xselect.c"
-                  (&optional selection terminal))
-(declare-function x-selection-exists-p "xselect.c"
-                  (&optional selection terminal))
 
 (defun deactivate-mark (&optional force)
   "Deactivate the mark.
@@ -4512,7 +4798,7 @@ 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 (or (region-active-p) force)
     (when (and (if (eq select-active-regions 'only)
 		   (eq (car-safe transient-mark-mode) 'only)
 		 select-active-regions)
@@ -4522,15 +4808,16 @@ run `deactivate-mark-hook'."
       ;; the region prior to the last command modifying the buffer.
       ;; Set the selection to that, or to the current region.
       (cond (saved-region-selection
-	     (x-set-selection 'PRIMARY saved-region-selection)
+	     (if (gui-backend-selection-owner-p 'PRIMARY)
+		 (gui-set-selection 'PRIMARY saved-region-selection))
 	     (setq saved-region-selection nil))
 	    ;; 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
-                              (funcall region-extract-function nil)))))
+		  (or (gui-backend-selection-owner-p 'PRIMARY)
+		      (null (gui-backend-selection-exists-p 'PRIMARY))))
+	     (gui-set-selection 'PRIMARY
+                                (funcall region-extract-function nil)))))
     (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382).
     (cond
      ((eq (car-safe transient-mark-mode) 'only)
@@ -4583,6 +4870,45 @@ store it in a Lisp variable.  Example:
     (setq mark-active nil)
     (set-marker (mark-marker) nil)))
 
+(defun save-mark-and-excursion--save ()
+  (cons
+   (let ((mark (mark-marker)))
+     (and (marker-position mark) (copy-marker mark)))
+   mark-active))
+
+(defun save-mark-and-excursion--restore (saved-mark-info)
+  (let ((saved-mark (car saved-mark-info))
+        (omark (marker-position (mark-marker)))
+        (nmark nil)
+        (saved-mark-active (cdr saved-mark-info)))
+    ;; Mark marker
+    (if (null saved-mark)
+        (set-marker (mark-marker) nil)
+      (setf nmark (marker-position saved-mark))
+      (set-marker (mark-marker) nmark)
+      (set-marker saved-mark nil))
+    ;; Mark active
+    (let ((cur-mark-active mark-active))
+      (setq mark-active saved-mark-active)
+      ;; If mark is active now, and either was not active or was at a
+      ;; different place, run the activate hook.
+      (if saved-mark-active
+          (when (or (not cur-mark-active)
+                    (not (eq omark nmark)))
+            (run-hooks 'activate-mark-hook))
+        ;; If mark has ceased to be active, run deactivate hook.
+        (when cur-mark-active
+          (run-hooks 'deactivate-mark-hook))))))
+
+(defmacro save-mark-and-excursion (&rest body)
+  "Like `save-excursion', but also save and restore the mark state.
+This macro does what `save-excursion' did before Emacs 25.1."
+  (let ((saved-marker-sym (make-symbol "saved-marker")))
+    `(let ((,saved-marker-sym (save-mark-and-excursion--save)))
+       (unwind-protect
+            (save-excursion ,@body)
+         (save-mark-and-excursion--restore ,saved-marker-sym)))))
+
 (defcustom use-empty-active-region nil
   "Whether \"region-aware\" commands should act on empty regions.
 If nil, region-aware commands treat empty regions as inactive.
@@ -4611,7 +4937,7 @@ For some commands, it may be appropriate to ignore the value of
        (or use-empty-active-region (> (region-end) (region-beginning)))))
 
 (defun region-active-p ()
-  "Return t if Transient Mark mode is enabled and the mark is active.
+  "Return non-nil if Transient Mark mode is enabled and the mark is active.
 
 Some commands act specially on the region when Transient Mark
 mode is enabled.  Usually, such commands should use
@@ -4622,7 +4948,7 @@ also checks the value of `use-empty-active-region'."
        ;; without the mark being set (e.g. bug#17324).  We really should fix
        ;; that problem, but in the mean time, let's make sure we don't say the
        ;; region is active when there's no mark.
-       (mark)))
+       (progn (cl-assert (mark)) t)))
 
 
 (defvar redisplay-unhighlight-region-function
@@ -4648,37 +4974,41 @@ also checks the value of `use-empty-active-region'."
       rol)))
 
 (defun redisplay--update-region-highlight (window)
-  (with-current-buffer (window-buffer window)
-    (let ((rol (window-parameter window 'internal-region-overlay)))
-      (if (not (region-active-p))
-          (funcall redisplay-unhighlight-region-function rol)
-        (let* ((pt (window-point window))
-               (mark (mark))
-               (start (min pt mark))
-               (end   (max pt mark))
-               (new
-                (funcall redisplay-highlight-region-function
-                         start end window rol)))
-          (unless (equal new rol)
-            (set-window-parameter window 'internal-region-overlay
-                                  new)))))))
-
-(defun redisplay--update-region-highlights (windows)
-  (with-demoted-errors "redisplay--update-region-highlights: %S"
+  (let ((rol (window-parameter window 'internal-region-overlay)))
+    (if (not (and (region-active-p)
+                  (or highlight-nonselected-windows
+                      (eq window (selected-window))
+                      (and (window-minibuffer-p)
+                           (eq window (minibuffer-selected-window))))))
+        (funcall redisplay-unhighlight-region-function rol)
+      (let* ((pt (window-point window))
+             (mark (mark))
+             (start (min pt mark))
+             (end   (max pt mark))
+             (new
+              (funcall redisplay-highlight-region-function
+                       start end window rol)))
+        (unless (equal new rol)
+          (set-window-parameter window 'internal-region-overlay
+                                new))))))
+
+(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight)
+  "Hook run just before redisplay.
+It is called in each window that is to be redisplayed.  It takes one argument,
+which is the window that will be redisplayed.  When run, the `current-buffer'
+is set to the buffer displayed in that window.")
+
+(defun redisplay--pre-redisplay-functions (windows)
+  (with-demoted-errors "redisplay--pre-redisplay-functions: %S"
     (if (null windows)
-        (redisplay--update-region-highlight (selected-window))
-      (unless (listp windows) (setq windows (window-list-1 nil nil t)))
-      (if highlight-nonselected-windows
-          (mapc #'redisplay--update-region-highlight windows)
-        (let ((msw (and (window-minibuffer-p) (minibuffer-selected-window))))
-          (dolist (w windows)
-            (if (or (eq w (selected-window)) (eq w msw))
-                (redisplay--update-region-highlight w)
-              (funcall redisplay-unhighlight-region-function
-                       (window-parameter w 'internal-region-overlay)))))))))
+        (with-current-buffer (window-buffer (selected-window))
+          (run-hook-with-args 'pre-redisplay-functions (selected-window)))
+      (dolist (win (if (listp windows) windows (window-list-1 nil nil t)))
+        (with-current-buffer (window-buffer win)
+          (run-hook-with-args 'pre-redisplay-functions win))))))
 
 (add-function :before pre-redisplay-function
-              #'redisplay--update-region-highlights)
+              #'redisplay--pre-redisplay-functions)
 
 
 (defvar-local mark-ring nil
@@ -4704,7 +5034,7 @@ Start discarding off end if gets this big."
 \(Does not affect global mark ring)."
   (interactive)
   (if (null (mark t))
-      (error "No mark set in this buffer")
+      (user-error "No mark set in this buffer")
     (if (= (point) (mark t))
 	(message "Mark popped"))
     (goto-char (mark t))
@@ -4853,7 +5183,7 @@ mode temporarily."
   (let ((omark (mark t))
 	(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
     (if (null omark)
-        (error "No mark set in this buffer"))
+        (user-error "No mark set in this buffer"))
     (set-mark (point))
     (goto-char omark)
     (cond (temp-highlight
@@ -4914,10 +5244,11 @@ positive, and disable it otherwise.  If called from Lisp, enable
 Transient Mark mode if ARG is omitted or nil.
 
 Transient Mark mode is a global minor mode.  When enabled, the
-region is highlighted whenever the mark is active.  The mark is
-\"deactivated\" by changing the buffer, and after certain other
-operations that set the mark but whose main purpose is something
-else--for example, incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
+region is highlighted with the `region' face whenever the mark
+is active.  The mark is \"deactivated\" by changing the buffer,
+and after certain other operations that set the mark but whose
+main purpose is something else--for example, incremental search,
+\\[beginning-of-buffer], and \\[end-of-buffer].
 
 You can also deactivate the mark by typing \\[keyboard-quit] or
 \\[keyboard-escape-quit].
@@ -5123,7 +5454,10 @@ lines."
 (declare-function font-info "font.c" (name &optional frame))
 
 (defun default-font-height ()
-  "Return the height in pixels of the current buffer's default face font."
+  "Return the height in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the height of the remapped face."
   (let ((default-font (face-font 'default)))
     (cond
      ((and (display-multi-font-p)
@@ -5134,6 +5468,25 @@ lines."
       (aref (font-info default-font) 3))
      (t (frame-char-height)))))
 
+(defun default-font-width ()
+  "Return the width in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the width of the remapped face."
+  (let ((default-font (face-font 'default)))
+    (cond
+     ((and (display-multi-font-p)
+	   ;; Avoid calling font-info if the frame's default font was
+	   ;; not changed since the frame was created.  That's because
+	   ;; font-info is expensive for some fonts, see bug #14838.
+	   (not (string= (frame-parameter nil 'font) default-font)))
+      (let* ((info (font-info (face-font 'default)))
+	     (width (aref info 11)))
+	(if (> width 0)
+	    width
+	  (aref info 10))))
+     (t (frame-char-width)))))
+
 (defun default-line-height ()
   "Return the pixel height of current buffer's default-face text line.
 
@@ -5287,7 +5640,7 @@ TRY-VSCROLL controls whether to vscroll tall lines: if either
 `auto-window-vscroll' or TRY-VSCROLL is nil, this function will
 not vscroll."
   (if noninteractive
-      (forward-line arg)
+      (line-move-1 arg noerror to-end)
     (unless (and auto-window-vscroll try-vscroll
 		 ;; Only vscroll for single line moves
 		 (= (abs arg) 1)
@@ -5350,15 +5703,24 @@ If NOERROR, don't signal an error if we can't move that many lines."
 		(>  (cdr temporary-goal-column) 0))
 	    (setq target-hscroll (cdr temporary-goal-column)))
       ;; Otherwise, we should reset `temporary-goal-column'.
-      (let ((posn (posn-at-point)))
+      (let ((posn (posn-at-point))
+	    x-pos)
 	(cond
 	 ;; Handle the `overflow-newline-into-fringe' case:
 	 ((eq (nth 1 posn) 'right-fringe)
 	  (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
 	 ((car (posn-x-y posn))
+	  (setq x-pos (car (posn-x-y posn)))
+	  ;; In R2L lines, the X pixel coordinate is measured from the
+	  ;; left edge of the window, but columns are still counted
+	  ;; from the logical-order beginning of the line, i.e. from
+	  ;; the right edge in this case.  We need to adjust for that.
+	  (if (eq (current-bidi-paragraph-direction) 'right-to-left)
+	      (setq x-pos (- (window-body-width nil t) 1 x-pos)))
 	  (setq temporary-goal-column
-		(cons (/ (float (car (posn-x-y posn)))
-			 (frame-char-width)) hscroll))))))
+		(cons (/ (float x-pos)
+			 (frame-char-width))
+                      hscroll))))))
     (if target-hscroll
 	(set-window-hscroll (selected-window) target-hscroll))
     ;; vertical-motion can move more than it was asked to if it moves
@@ -5638,7 +6000,11 @@ and `current-column' to be able to ignore invisible text."
 	;; that will get us to the same place on the screen
 	;; but with a more reasonable buffer position.
 	(goto-char normal-location)
-	(let ((line-beg (line-beginning-position)))
+	(let ((line-beg
+               ;; We want the real line beginning, so it's consistent
+               ;; with bolp below, otherwise we might infloop.
+               (let ((inhibit-field-text-motion t))
+                 (line-beginning-position))))
 	  (while (and (not (bolp)) (invisible-p (1- (point))))
 	    (goto-char (previous-char-property-change (point) line-beg))))))))
 
@@ -6309,7 +6675,7 @@ beyond `current-fill-column' automatically breaks the line at a
 previous space.
 
 When `auto-fill-mode' is on, the `auto-fill-function' variable is
-non-`nil'.
+non-nil.
 
 The value of `normal-auto-fill-function' specifies the function to use
 for `auto-fill-function' when turning Auto Fill mode on."
@@ -6669,8 +7035,9 @@ The function should return non-nil if the two tokens do not match.")
                     (buffer-substring blinkpos (1+ blinkpos))))
                   ;; There is nothing to show except the char itself.
                   (t (buffer-substring blinkpos (1+ blinkpos))))))
-            (message "Matches %s"
-                     (substring-no-properties open-paren-line-string)))))))))
+            (minibuffer-message
+             "Matches %s"
+             (substring-no-properties open-paren-line-string)))))))))
 
 (defvar blink-paren-function 'blink-matching-open
   "Function called, if non-nil, whenever a close parenthesis is inserted.
@@ -6683,6 +7050,8 @@ More precisely, a char with closeparen syntax is self-inserted.")
              (not executing-kbd-macro)
              (not noninteractive)
 	     ;; Verify an even number of quoting characters precede the close.
+             ;; FIXME: Also check if this parenthesis closes a comment as
+             ;; can happen in Pascal and SML.
 	     (= 1 (logand 1 (- (point)
 			       (save-excursion
 				 (forward-char -1)
@@ -7577,7 +7946,9 @@ DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
 This is always done when called interactively.
 
 Optional third arg NORECORD non-nil means do not put this buffer at the
-front of the list of recently selected ones."
+front of the list of recently selected ones.
+
+Returns the newly created indirect buffer."
   (interactive
    (progn
      (if (get major-mode 'no-clone-indirect)
@@ -7861,7 +8232,7 @@ version and use the one distributed with Emacs."))
 Each element has the form (PACKAGE SYMBOL REGEXP STRING).
 PACKAGE is either a regular expression to match file names, or a
 symbol (a feature name), like for `with-eval-after-load'.
-SYMBOL is either the name of a string variable, or `t'.  Upon
+SYMBOL is either the name of a string variable, or t.  Upon
 loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
 warning using STRING as the message.")