Merge branch 'master' into scratch/correct-warning-pos

9 files changed, 687 insertions, 189 deletions

diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index a51fd8ca255..d0bf342b842 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -340,7 +340,7 @@ put the output in."
    (t
     (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
 	  (outbuf autoload-print-form-outbuf))
-      (if (and doc-string-elt (stringp (nth doc-string-elt form)))
+      (if (and (numberp doc-string-elt) (stringp (nth doc-string-elt form)))
 	  ;; We need to hack the printing because the
 	  ;; doc-string must be printed specially for
 	  ;; make-docfile (sigh).
@@ -410,7 +410,7 @@ FILE's name."
 	    ";; version-control: never\n"
             ";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil.
 	    ";; no-update-autoloads: t\n"
-	    ";; coding: utf-8\n"
+	    ";; coding: utf-8-emacs-unix\n"
 	    ";; End:\n"
 	    ";;; " basename
 	    " ends here\n")))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 587819f36ed..d6054aef5e1 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -617,8 +617,8 @@ Each element is (INDEX . VALUE)")
   "Hash byte-code -> byte-to-native-lambda.")
 (defvar byte-to-native-top-level-forms nil
   "List of top level forms.")
-(defvar byte-to-native-output-file nil
-  "Temporary file containing the byte-compilation output.")
+(defvar byte-to-native-output-buffer-file nil
+  "Pair holding byte-compilation output buffer, elc filename.")
 (defvar byte-to-native-plist-environment nil
   "To spill `overriding-plist-environment'.")
 
@@ -1986,6 +1986,42 @@ If compilation is needed, this functions returns the result of
 (defvar byte-compile-level 0		; bug#13787
   "Depth of a recursive byte compilation.")
 
+(defun byte-write-target-file (buffer target-file)
+  "Write BUFFER into TARGET-FILE."
+  (with-current-buffer buffer
+    ;; We must disable any code conversion here.
+    (let* ((coding-system-for-write 'no-conversion)
+	   ;; Write to a tempfile so that if another Emacs
+	   ;; process is trying to load target-file (eg in a
+	   ;; parallel bootstrap), it does not risk getting a
+	   ;; half-finished file.  (Bug#4196)
+	   (tempfile
+	    (make-temp-file (when (file-writable-p target-file)
+                              (expand-file-name target-file))))
+	   (default-modes (default-file-modes))
+	   (temp-modes (logand default-modes #o600))
+	   (desired-modes (logand default-modes #o666))
+	   (kill-emacs-hook
+	    (cons (lambda () (ignore-errors
+			  (delete-file tempfile)))
+		  kill-emacs-hook)))
+      (unless (= temp-modes desired-modes)
+        (set-file-modes tempfile desired-modes 'nofollow))
+      (write-region (point-min) (point-max) tempfile nil 1)
+      ;; This has the intentional side effect that any
+      ;; hard-links to target-file continue to
+      ;; point to the old file (this makes it possible
+      ;; for installed files to share disk space with
+      ;; the build tree, without causing problems when
+      ;; emacs-lisp files in the build tree are
+      ;; recompiled).  Previously this was accomplished by
+      ;; deleting target-file before writing it.
+      (if byte-native-compiling
+          ;; Defer elc final renaming.
+          (setf byte-to-native-output-buffer-file
+                (cons tempfile target-file))
+        (rename-file tempfile target-file t)))))
+
 ;;;###autoload
 (defun byte-compile-file (filename &optional load)
   "Compile a file of Lisp code named FILENAME into a file of byte code.
@@ -2020,176 +2056,148 @@ See also `emacs-lisp-byte-compile-and-load'."
 
   ;; Force logging of the file name for each file compiled.
   (setq byte-compile-last-logged-file nil)
-  (prog1
-      (let ((byte-compile-current-file filename)
-            (byte-compile-current-group nil)
-	    (set-auto-coding-for-load t)
-            (byte-compile--seen-defvars nil)
-            (byte-compile--known-dynamic-vars
-             (byte-compile--load-dynvars (getenv "EMACS_DYNVARS_FILE")))
-	    target-file input-buffer output-buffer
-	    byte-compile-dest-file byte-compiler-error-flag)
-        (setq target-file (byte-compile-dest-file filename))
-        (setq byte-compile-dest-file target-file)
-        (with-current-buffer
-	    ;; It would be cleaner to use a temp buffer, but if there was
-	    ;; an error, we leave this buffer around for diagnostics.
-	    ;; Its name is documented in the lispref.
-	    (setq input-buffer (get-buffer-create
-			        (concat " *Compiler Input*"
-				        (if (zerop byte-compile-level) ""
-				          (format "-%s" byte-compile-level)))))
-          (erase-buffer)
-          (setq buffer-file-coding-system nil)
-          ;; Always compile an Emacs Lisp file as multibyte
-          ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
-          (set-buffer-multibyte t)
-          (insert-file-contents filename)
-          ;; Mimic the way after-insert-file-set-coding can make the
-          ;; buffer unibyte when visiting this file.
-          (when (or (eq last-coding-system-used 'no-conversion)
-		    (eq (coding-system-type last-coding-system-used) 5))
-	    ;; For coding systems no-conversion and raw-text...,
-	    ;; edit the buffer as unibyte.
-	    (set-buffer-multibyte nil))
-          ;; Run hooks including the uncompression hook.
-          ;; If they change the file name, then change it for the output also.
-          (let ((buffer-file-name filename)
-                (dmm (default-value 'major-mode))
-                ;; Ignore unsafe local variables.
-                ;; We only care about a few of them for our purposes.
-                (enable-local-variables :safe)
-                (enable-local-eval nil))
-            (unwind-protect
-                (progn
-                  (setq-default major-mode 'emacs-lisp-mode)
-                  ;; Arg of t means don't alter enable-local-variables.
-                  (delay-mode-hooks (normal-mode t)))
-              (setq-default major-mode dmm))
-            ;; There may be a file local variable setting (bug#10419).
-            (setq buffer-read-only nil
-                  filename buffer-file-name))
-          ;; Don't inherit lexical-binding from caller (bug#12938).
-          (unless (local-variable-p 'lexical-binding)
-            (setq-local lexical-binding nil))
-          ;; Set the default directory, in case an eval-when-compile uses it.
-          (setq default-directory (file-name-directory filename)))
-        ;; Check if the file's local variables explicitly specify not to
-        ;; compile this file.
-        (if (with-current-buffer input-buffer no-byte-compile)
-	    (progn
-	      ;; (message "%s not compiled because of `no-byte-compile: %s'"
-	      ;; 	   (byte-compile-abbreviate-file filename)
-	      ;; 	   (with-current-buffer input-buffer no-byte-compile))
-	      (when (and target-file (file-exists-p target-file))
-	        (message "%s deleted because of `no-byte-compile: %s'"
-		         (byte-compile-abbreviate-file target-file)
-		         (buffer-local-value 'no-byte-compile input-buffer))
-	        (condition-case nil (delete-file target-file) (error nil)))
-	      ;; We successfully didn't compile this file.
-	      'no-byte-compile)
-          (when byte-compile-verbose
-	    (message "Compiling %s..." filename))
-          ;; It is important that input-buffer not be current at this call,
-          ;; so that the value of point set in input-buffer
-          ;; within byte-compile-from-buffer lingers in that buffer.
-          (setq output-buffer
-	        (save-current-buffer
-	          (let ((symbols-with-pos-enabled t)
-                        (byte-compile-level (1+ byte-compile-level)))
-                    (byte-compile-from-buffer input-buffer))))
-          (if byte-compiler-error-flag
-	      nil
-	    (when byte-compile-verbose
-	      (message "Compiling %s...done" filename))
-	    (kill-buffer input-buffer)
-	    (with-current-buffer output-buffer
-              (when (and target-file
-                         (or (not byte-native-compiling)
-                             (and byte-native-compiling byte+native-compile)))
-	        (goto-char (point-max))
-	        (insert "\n")           ; aaah, unix.
-	        (cond
-	         ((and (file-writable-p target-file)
-		       ;; We attempt to create a temporary file in the
-		       ;; target directory, so the target directory must be
-		       ;; writable.
-		       (file-writable-p
-		        (file-name-directory
-		         ;; Need to expand in case TARGET-FILE doesn't
-		         ;; include a directory (Bug#45287).
-		         (expand-file-name target-file))))
-	          ;; We must disable any code conversion here.
-	          (let* ((coding-system-for-write 'no-conversion)
-		         ;; Write to a tempfile so that if another Emacs
-		         ;; process is trying to load target-file (eg in a
-		         ;; parallel bootstrap), it does not risk getting a
-		         ;; half-finished file.  (Bug#4196)
-		         (tempfile
-		          (make-temp-file (when (file-writable-p target-file)
-                                            (expand-file-name target-file))))
-		         (default-modes (default-file-modes))
-		         (temp-modes (logand default-modes #o600))
-		         (desired-modes (logand default-modes #o666))
-		         (kill-emacs-hook
-		          (cons (lambda () (ignore-errors
-				             (delete-file tempfile)))
-			        kill-emacs-hook)))
-	            (unless (= temp-modes desired-modes)
-		      (set-file-modes tempfile desired-modes 'nofollow))
-	            (write-region (point-min) (point-max) tempfile nil 1)
-	            ;; This has the intentional side effect that any
-	            ;; hard-links to target-file continue to
-	            ;; point to the old file (this makes it possible
-	            ;; for installed files to share disk space with
-	            ;; the build tree, without causing problems when
-	            ;; emacs-lisp files in the build tree are
-	            ;; recompiled).  Previously this was accomplished by
-	            ;; deleting target-file before writing it.
-	            (if byte-native-compiling
-                        ;; Defer elc final renaming.
-                        (setf byte-to-native-output-file
-                              (cons tempfile target-file))
-                      (rename-file tempfile target-file t)))
-	          (or noninteractive
-		      byte-native-compiling
-		      (message "Wrote %s" target-file)))
-                 ((file-writable-p target-file)
-                  ;; In case the target directory isn't writable (see e.g. Bug#44631),
-                  ;; try writing to the output file directly.  We must disable any
-                  ;; code conversion here.
-                  (let ((coding-system-for-write 'no-conversion))
-                    (with-file-modes (logand (default-file-modes) #o666)
-                      (write-region (point-min) (point-max) target-file nil 1)))
-                  (or noninteractive (message "Wrote %s" target-file)))
-	         (t
-	          ;; This is just to give a better error message than write-region
-	          (let ((exists (file-exists-p target-file)))
-	            (signal (if exists 'file-error 'file-missing)
-		            (list "Opening output file"
-			          (if exists
-				      "Cannot overwrite file"
-			            "Directory not writable or nonexistent")
-			          target-file))))))
-	      (kill-buffer (current-buffer)))
-	    (if (and byte-compile-generate-call-tree
-		     (or (eq t byte-compile-generate-call-tree)
-		         (y-or-n-p (format "Report call tree for %s? "
-                                           filename))))
-	        (save-excursion
-	          (display-call-tree filename)))
-            (let ((gen-dynvars (getenv "EMACS_GENERATE_DYNVARS")))
-              (when (and gen-dynvars (not (equal gen-dynvars ""))
-                         byte-compile--seen-defvars)
-                (let ((dynvar-file (concat target-file ".dynvars")))
-                  (message "Generating %s" dynvar-file)
-                  (with-temp-buffer
-                    (dolist (var (delete-dups byte-compile--seen-defvars))
-                      (insert (format "%S\n" (cons var filename))))
-	            (write-region (point-min) (point-max) dynvar-file)))))
-	    (if load
-                (load target-file))
-	    t)))))
+  (let ((byte-compile-current-file filename)
+        (byte-compile-current-group nil)
+	(set-auto-coding-for-load t)
+        (byte-compile--seen-defvars nil)
+        (byte-compile--known-dynamic-vars
+         (byte-compile--load-dynvars (getenv "EMACS_DYNVARS_FILE")))
+	target-file input-buffer output-buffer
+	byte-compile-dest-file byte-compiler-error-flag)
+    (setq target-file (byte-compile-dest-file filename))
+    (setq byte-compile-dest-file target-file)
+    (with-current-buffer
+	;; It would be cleaner to use a temp buffer, but if there was
+	;; an error, we leave this buffer around for diagnostics.
+	;; Its name is documented in the lispref.
+	(setq input-buffer (get-buffer-create
+			    (concat " *Compiler Input*"
+				    (if (zerop byte-compile-level) ""
+				      (format "-%s" byte-compile-level)))))
+      (erase-buffer)
+      (setq buffer-file-coding-system nil)
+      ;; Always compile an Emacs Lisp file as multibyte
+      ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
+      (set-buffer-multibyte t)
+      (insert-file-contents filename)
+      ;; Mimic the way after-insert-file-set-coding can make the
+      ;; buffer unibyte when visiting this file.
+      (when (or (eq last-coding-system-used 'no-conversion)
+		(eq (coding-system-type last-coding-system-used) 5))
+	;; For coding systems no-conversion and raw-text...,
+	;; edit the buffer as unibyte.
+	(set-buffer-multibyte nil))
+      ;; Run hooks including the uncompression hook.
+      ;; If they change the file name, then change it for the output also.
+      (let ((buffer-file-name filename)
+            (dmm (default-value 'major-mode))
+            ;; Ignore unsafe local variables.
+            ;; We only care about a few of them for our purposes.
+            (enable-local-variables :safe)
+            (enable-local-eval nil))
+        (unwind-protect
+            (progn
+              (setq-default major-mode 'emacs-lisp-mode)
+              ;; Arg of t means don't alter enable-local-variables.
+              (delay-mode-hooks (normal-mode t)))
+          (setq-default major-mode dmm))
+        ;; There may be a file local variable setting (bug#10419).
+        (setq buffer-read-only nil
+              filename buffer-file-name))
+      ;; Don't inherit lexical-binding from caller (bug#12938).
+      (unless (local-variable-p 'lexical-binding)
+        (setq-local lexical-binding nil))
+      ;; Set the default directory, in case an eval-when-compile uses it.
+      (setq default-directory (file-name-directory filename)))
+    ;; Check if the file's local variables explicitly specify not to
+    ;; compile this file.
+    (if (with-current-buffer input-buffer no-byte-compile)
+	(progn
+	  ;; (message "%s not compiled because of `no-byte-compile: %s'"
+	  ;; 	   (byte-compile-abbreviate-file filename)
+	  ;; 	   (with-current-buffer input-buffer no-byte-compile))
+	  (when (and target-file (file-exists-p target-file))
+	    (message "%s deleted because of `no-byte-compile: %s'"
+		     (byte-compile-abbreviate-file target-file)
+		     (buffer-local-value 'no-byte-compile input-buffer))
+	    (condition-case nil (delete-file target-file) (error nil)))
+	  ;; We successfully didn't compile this file.
+	  'no-byte-compile)
+      (when byte-compile-verbose
+	(message "Compiling %s..." filename))
+      ;; It is important that input-buffer not be current at this call,
+      ;; so that the value of point set in input-buffer
+      ;; within byte-compile-from-buffer lingers in that buffer.
+      (setq output-buffer
+	    (save-current-buffer
+	      (let ((byte-compile-level (1+ byte-compile-level)))
+                (byte-compile-from-buffer input-buffer))))
+      (if byte-compiler-error-flag
+	  nil
+	(when byte-compile-verbose
+	  (message "Compiling %s...done" filename))
+	(kill-buffer input-buffer)
+	(with-current-buffer output-buffer
+          (when (and target-file
+                     (or (not byte-native-compiling)
+                         (and byte-native-compiling byte+native-compile)))
+	    (goto-char (point-max))
+	    (insert "\n")			; aaah, unix.
+	    (cond
+	     ((and (file-writable-p target-file)
+		   ;; We attempt to create a temporary file in the
+		   ;; target directory, so the target directory must be
+		   ;; writable.
+		   (file-writable-p
+		    (file-name-directory
+		     ;; Need to expand in case TARGET-FILE doesn't
+		     ;; include a directory (Bug#45287).
+		     (expand-file-name target-file))))
+              (if byte-native-compiling
+                  ;; Defer elc production.
+                  (setf byte-to-native-output-buffer-file
+                        (cons (current-buffer) target-file))
+                (byte-write-target-file (current-buffer) target-file))
+	      (or noninteractive
+		  byte-native-compiling
+		  (message "Wrote %s" target-file)))
+             ((file-writable-p target-file)
+              ;; In case the target directory isn't writable (see e.g. Bug#44631),
+              ;; try writing to the output file directly.  We must disable any
+              ;; code conversion here.
+              (let ((coding-system-for-write 'no-conversion))
+                (with-file-modes (logand (default-file-modes) #o666)
+                  (write-region (point-min) (point-max) target-file nil 1)))
+              (or noninteractive (message "Wrote %s" target-file)))
+	     (t
+	      ;; This is just to give a better error message than write-region
+	      (let ((exists (file-exists-p target-file)))
+	        (signal (if exists 'file-error 'file-missing)
+		        (list "Opening output file"
+			      (if exists
+				  "Cannot overwrite file"
+			        "Directory not writable or nonexistent")
+			      target-file))))))
+          (unless byte-native-compiling
+	    (kill-buffer (current-buffer))))
+	(if (and byte-compile-generate-call-tree
+		 (or (eq t byte-compile-generate-call-tree)
+		     (y-or-n-p (format "Report call tree for %s? "
+                                       filename))))
+	    (save-excursion
+	      (display-call-tree filename)))
+        (let ((gen-dynvars (getenv "EMACS_GENERATE_DYNVARS")))
+          (when (and gen-dynvars (not (equal gen-dynvars ""))
+                     byte-compile--seen-defvars)
+            (let ((dynvar-file (concat target-file ".dynvars")))
+              (message "Generating %s" dynvar-file)
+              (with-temp-buffer
+                (dolist (var (delete-dups byte-compile--seen-defvars))
+                  (insert (format "%S\n" (cons var filename))))
+	        (write-region (point-min) (point-max) dynvar-file)))))
+	(if load
+            (load target-file))
+	t))))
 
 ;;; compiling a single function
 ;;;###autoload
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index dd5ad5a440b..74b0b1197be 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -4213,11 +4213,13 @@ variable 'NATIVE_DISABLED' is set, only byte compile."
       (batch-byte-compile)
     (cl-assert (length= command-line-args-left 1))
     (let ((byte+native-compile t)
-          (byte-to-native-output-file nil))
+          (byte-to-native-output-buffer-file nil))
       (batch-native-compile)
-      (pcase byte-to-native-output-file
-        (`(,tempfile . ,target-file)
-         (rename-file tempfile target-file t)))
+      (pcase byte-to-native-output-buffer-file
+        (`(,temp-buffer . ,target-file)
+         (unwind-protect
+             (byte-write-target-file temp-buffer target-file))
+         (kill-buffer temp-buffer)))
       (setq command-line-args-left (cdr command-line-args-left)))))
 
 ;;;###autoload
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index fe97804ec4a..1720393b3e5 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -98,7 +98,11 @@ This applies to `eval-defun', `eval-region', `eval-buffer', and
 You can use the command `edebug-all-defs' to toggle the value of this
 variable.  You may wish to make it local to each buffer with
 \(make-local-variable \\='edebug-all-defs) in your
-`emacs-lisp-mode-hook'."
+`emacs-lisp-mode-hook'.
+
+Note that this user option has no effect unless the edebug
+package has been loaded."
+  :require 'edebug
   :type 'boolean)
 
 ;;;###autoload
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 9c6b0e15bbe..b6c5b7d6b91 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1423,7 +1423,8 @@ Returns the stats object."
                          (message "%9s  %S%s"
                                   (ert-string-for-test-result result nil)
                                   (ert-test-name test)
-                                  (if (getenv "EMACS_TEST_VERBOSE")
+                                  (if (cl-plusp
+                                       (length (getenv "EMACS_TEST_VERBOSE")))
                                       (ert-reason-for-test-result result)
                                     ""))))
               (message "%s" ""))
@@ -1435,7 +1436,8 @@ Returns the stats object."
                          (message "%9s  %S%s"
                                   (ert-string-for-test-result result nil)
                                   (ert-test-name test)
-                                  (if (getenv "EMACS_TEST_VERBOSE")
+                                  (if (cl-plusp
+                                       (length (getenv "EMACS_TEST_VERBOSE")))
                                       (ert-reason-for-test-result result)
                                     ""))))
               (message "%s" ""))
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index e6a2424c518..4a293796a83 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -434,10 +434,16 @@ storage method to list."
                multisession-edit-mode)
   (unless id
     (error "No value on the current line"))
-  (let* ((object (make-multisession
-                  :package (car id)
-                  :key (cdr id)
-                  :storage multisession-storage))
+  (let* ((object (or
+                  ;; If the multisession variable already exists, use
+                  ;; it (so that we update it).
+                  (and (boundp (intern-soft (cdr id)))
+                       (symbol-value (intern (cdr id))))
+                  ;; Create a new object.
+                  (make-multisession
+                   :package (car id)
+                   :key (cdr id)
+                   :storage multisession-storage)))
          (value (multisession-value object)))
     (setf (multisession-value object)
           (car (read-from-string
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index d199716b2c5..e782cdb1dab 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -273,7 +273,10 @@ Use the `pp-max-width' variable to control the desired line length."
     (insert "(")
     (pp--insert start (pop sexp))
     (while sexp
-      (pp--insert " " (pop sexp)))
+      (if (consp sexp)
+          (pp--insert " " (pop sexp))
+        (pp--insert " . " sexp)
+        (setq sexp nil)))
     (insert ")")))
 
 (defun pp--format-function (sexp)
diff --git a/lisp/emacs-lisp/range.el b/lisp/emacs-lisp/range.el
new file mode 100644
index 00000000000..38c2866cd4c
--- /dev/null
+++ b/lisp/emacs-lisp/range.el
@@ -0,0 +1,467 @@
+;;; ranges.el --- range functions  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A "range" is a list that represents a list of integers.  A range is
+;; a list containing cons cells of start/end pairs, as well as integers.
+;;
+;; ((2 . 5) 9 (11 . 13))
+;;
+;; represents the list (2 3 4 5 9 11 12 13).
+
+;;; Code:
+
+(defun range-normalize (range)
+  "Normalize RANGE.
+If RANGE is a single range, return (RANGE).  Otherwise, return RANGE."
+  (if (listp (cdr-safe range))
+      range
+    (list range)))
+
+(defun range-denormalize (range)
+  "If RANGE contains a single range, then return that.
+If not, return RANGE as is."
+  (if (and (consp (car range))
+           (length= range 1))
+      (car range)
+    range))
+
+(defun range-difference (range1 range2)
+  "Return the range of elements in RANGE1 that do not appear in RANGE2.
+Both ranges must be in ascending order."
+  (setq range1 (range-normalize range1))
+  (setq range2 (range-normalize range2))
+  (let* ((new-range (cons nil (copy-sequence range1)))
+         (r new-range))
+    (while (cdr r)
+      (let* ((r1 (cadr r))
+             (r2 (car range2))
+             (min1 (if (numberp r1) r1 (car r1)))
+             (max1 (if (numberp r1) r1 (cdr r1)))
+             (min2 (if (numberp r2) r2 (car r2)))
+             (max2 (if (numberp r2) r2 (cdr r2))))
+
+        (cond ((> min1 max1)
+               ;; Invalid range: may result from overlap condition (below)
+               ;; remove Invalid range
+               (setcdr r (cddr r)))
+              ((and (= min1 max1)
+                    (listp r1))
+               ;; Inefficient representation: may result from overlap
+               ;; condition (below)
+               (setcar (cdr r) min1))
+              ((not min2)
+               ;; All done with range2
+               (setq r nil))
+              ((< max1 min2)
+               ;; No overlap: range1 precedes range2
+               (pop r))
+              ((< max2 min1)
+               ;; No overlap: range2 precedes range1
+               (pop range2))
+              ((and (<= min2 min1) (<= max1 max2))
+               ;; Complete overlap: range1 removed
+               (setcdr r (cddr r)))
+              (t
+               (setcdr r (nconc (list (cons min1 (1- min2))
+                                      (cons (1+ max2) max1))
+                                (cddr r)))))))
+    (cdr new-range)))
+
+(defun range-intersection (range1 range2)
+  "Return intersection of RANGE1 and RANGE2."
+  (let* (out
+         (min1 (car range1))
+         (max1 (if (numberp min1)
+                   (if (numberp (cdr range1))
+                       (prog1 (cdr range1)
+                         (setq range1 nil)) min1)
+                 (prog1 (cdr min1)
+                   (setq min1 (car min1)))))
+         (min2 (car range2))
+         (max2 (if (numberp min2)
+                   (if (numberp (cdr range2))
+                       (prog1 (cdr range2)
+                         (setq range2 nil)) min2)
+                 (prog1 (cdr min2)
+                   (setq min2 (car min2))))))
+    (setq range1 (cdr range1)
+          range2 (cdr range2))
+    (while (and min1 min2)
+      (cond ((< max1 min2)              ; range1 precedes range2
+             (setq range1 (cdr range1)
+                   min1 nil))
+            ((< max2 min1)              ; range2 precedes range1
+             (setq range2 (cdr range2)
+                   min2 nil))
+            (t                     ; some sort of overlap is occurring
+             (let ((min (max min1 min2))
+                   (max (min max1 max2)))
+               (setq out (if (= min max)
+                             (cons min out)
+                           (cons (cons min max) out))))
+             (if (< max1 max2)          ; range1 ends before range2
+                 (setq min1 nil)        ; incr range1
+               (setq min2 nil))))       ; incr range2
+      (unless min1
+        (setq min1 (car range1)
+              max1 (if (numberp min1) min1
+                     (prog1 (cdr min1) (setq min1 (car min1))))
+              range1 (cdr range1)))
+      (unless min2
+        (setq min2 (car range2)
+              max2 (if (numberp min2) min2
+                     (prog1 (cdr min2) (setq min2 (car min2))))
+              range2 (cdr range2))))
+    (cond ((cdr out)
+           (nreverse out))
+          ((numberp (car out))
+           out)
+          (t
+           (car out)))))
+
+(defun range-compress-list (numbers)
+  "Convert a sorted list of numbers to a range list."
+  (let ((first (car numbers))
+	(last (car numbers))
+	result)
+    (cond
+     ((null numbers)
+      nil)
+     ((not (listp (cdr numbers)))
+      numbers)
+     (t
+      (while numbers
+	(cond ((= last (car numbers)) nil)   ;Omit duplicated number
+	      ((= (1+ last) (car numbers))   ;Still in sequence
+	       (setq last (car numbers)))
+	      (t			;End of one sequence
+	       (setq result
+		     (cons (if (= first last) first
+			     (cons first last))
+			   result))
+	       (setq first (car numbers))
+	       (setq last  (car numbers))))
+	(setq numbers (cdr numbers)))
+      (nreverse (cons (if (= first last) first (cons first last))
+		      result))))))
+
+(defun range-uncompress (ranges)
+  "Expand a list of ranges into a list of numbers.
+RANGES is either a single range on the form `(num . num)' or a list of
+these ranges."
+  (let (first last result)
+    (cond
+     ((null ranges)
+      nil)
+     ((not (listp (cdr ranges)))
+      (setq first (car ranges))
+      (setq last (cdr ranges))
+      (while (<= first last)
+	(setq result (cons first result))
+	(setq first (1+ first)))
+      (nreverse result))
+     (t
+      (while ranges
+	(if (atom (car ranges))
+	    (when (numberp (car ranges))
+	      (setq result (cons (car ranges) result)))
+	  (setq first (caar ranges))
+	  (setq last  (cdar ranges))
+	  (while (<= first last)
+	    (setq result (cons first result))
+	    (setq first (1+ first))))
+	(setq ranges (cdr ranges)))
+      (nreverse result)))))
+
+(defun range-add-list (ranges list)
+  "Return a list of ranges that has all articles from both RANGES and LIST.
+Note: LIST has to be sorted over `<'."
+  (if (not ranges)
+      (range-compress-list list)
+    (setq list (copy-sequence list))
+    (unless (listp (cdr ranges))
+      (setq ranges (list ranges)))
+    (let ((out ranges)
+	  ilist lowest highest temp)
+      (while (and ranges list)
+	(setq ilist list)
+	(setq lowest (or (and (atom (car ranges)) (car ranges))
+			 (caar ranges)))
+	(while (and list (cdr list) (< (cadr list) lowest))
+	  (setq list (cdr list)))
+	(when (< (car ilist) lowest)
+	  (setq temp list)
+	  (setq list (cdr list))
+	  (setcdr temp nil)
+	  (setq out (nconc (range-compress-list ilist) out)))
+	(setq highest (or (and (atom (car ranges)) (car ranges))
+			  (cdar ranges)))
+	(while (and list (<= (car list) highest))
+	  (setq list (cdr list)))
+	(setq ranges (cdr ranges)))
+      (when list
+	(setq out (nconc (range-compress-list list) out)))
+      (setq out (sort out (lambda (r1 r2)
+			    (< (or (and (atom r1) r1) (car r1))
+			       (or (and (atom r2) r2) (car r2))))))
+      (setq ranges out)
+      (while ranges
+	(if (atom (car ranges))
+	    (when (cdr ranges)
+	      (if (atom (cadr ranges))
+		  (when (= (1+ (car ranges)) (cadr ranges))
+		    (setcar ranges (cons (car ranges)
+					 (cadr ranges)))
+		    (setcdr ranges (cddr ranges)))
+		(when (= (1+ (car ranges)) (caadr ranges))
+		  (setcar (cadr ranges) (car ranges))
+		  (setcar ranges (cadr ranges))
+		  (setcdr ranges (cddr ranges)))))
+	  (when (cdr ranges)
+	    (if (atom (cadr ranges))
+		(when (= (1+ (cdar ranges)) (cadr ranges))
+		  (setcdr (car ranges) (cadr ranges))
+		  (setcdr ranges (cddr ranges)))
+	      (when (= (1+ (cdar ranges)) (caadr ranges))
+		(setcdr (car ranges) (cdadr ranges))
+		(setcdr ranges (cddr ranges))))))
+	(setq ranges (cdr ranges)))
+      out)))
+
+(defun range-remove (range1 range2)
+  "Return a range that has all articles from RANGE2 removed from RANGE1.
+The returned range is always a list.  RANGE2 can also be a unsorted
+list of articles.  RANGE1 is modified by side effects, RANGE2 is not
+modified."
+  (if (or (null range1) (null range2))
+      range1
+    (let (out r1 r2 r1-min r1-max r2-min r2-max
+	      (range2 (copy-tree range2)))
+      (setq range1 (if (listp (cdr range1)) range1 (list range1))
+	    range2 (sort (if (listp (cdr range2)) range2 (list range2))
+			 (lambda (e1 e2)
+			   (< (if (consp e1) (car e1) e1)
+			      (if (consp e2) (car e2) e2))))
+	    r1 (car range1)
+	    r2 (car range2)
+	    r1-min (if (consp r1) (car r1) r1)
+	    r1-max (if (consp r1) (cdr r1) r1)
+	    r2-min (if (consp r2) (car r2) r2)
+	    r2-max (if (consp r2) (cdr r2) r2))
+      (while (and range1 range2)
+	(cond ((< r2-max r1-min)	; r2 < r1
+	       (pop range2)
+	       (setq r2 (car range2)
+		     r2-min (if (consp r2) (car r2) r2)
+		     r2-max (if (consp r2) (cdr r2) r2)))
+	      ((and (<= r2-min r1-min) (<= r1-max r2-max)) ; r2 overlap r1
+	       (pop range1)
+	       (setq r1 (car range1)
+		     r1-min (if (consp r1) (car r1) r1)
+		     r1-max (if (consp r1) (cdr r1) r1)))
+	      ((and (<= r2-min r1-min) (<= r2-max r1-max)) ; r2 overlap min r1
+	       (pop range2)
+	       (setq r1-min (1+ r2-max)
+		     r2 (car range2)
+		     r2-min (if (consp r2) (car r2) r2)
+		     r2-max (if (consp r2) (cdr r2) r2)))
+	      ((and (<= r1-min r2-min) (<= r2-max r1-max)) ; r2 contained in r1
+	       (if (eq r1-min (1- r2-min))
+		   (push r1-min out)
+		 (push (cons r1-min (1- r2-min)) out))
+	       (pop range2)
+	       (if (< r2-max r1-max)	; finished with r1?
+		   (setq r1-min (1+ r2-max))
+		 (pop range1)
+		 (setq r1 (car range1)
+		       r1-min (if (consp r1) (car r1) r1)
+		       r1-max (if (consp r1) (cdr r1) r1)))
+	       (setq r2 (car range2)
+		     r2-min (if (consp r2) (car r2) r2)
+		     r2-max (if (consp r2) (cdr r2) r2)))
+	      ((and (<= r2-min r1-max) (<= r1-max r2-max)) ; r2 overlap max r1
+	       (if (eq r1-min (1- r2-min))
+		   (push r1-min out)
+		 (push (cons r1-min (1- r2-min)) out))
+	       (pop range1)
+	       (setq r1 (car range1)
+		     r1-min (if (consp r1) (car r1) r1)
+		     r1-max (if (consp r1) (cdr r1) r1)))
+	      ((< r1-max r2-min)	; r2 > r1
+	       (pop range1)
+	       (if (eq r1-min r1-max)
+		   (push r1-min out)
+		 (push (cons r1-min r1-max) out))
+	       (setq r1 (car range1)
+		     r1-min (if (consp r1) (car r1) r1)
+		     r1-max (if (consp r1) (cdr r1) r1)))))
+      (when r1
+	(if (eq r1-min r1-max)
+	    (push r1-min out)
+	  (push (cons r1-min r1-max) out))
+	(pop range1))
+      (while range1
+	(push (pop range1) out))
+      (nreverse out))))
+
+(defun range-member-p (number ranges)
+  "Say whether NUMBER is in RANGES."
+  (if (not (listp (cdr ranges)))
+      (and (>= number (car ranges))
+	   (<= number (cdr ranges)))
+    (let ((not-stop t))
+      (while (and ranges
+		  (if (numberp (car ranges))
+		      (>= number (car ranges))
+		    (>= number (caar ranges)))
+		  not-stop)
+	(when (if (numberp (car ranges))
+		  (= number (car ranges))
+		(and (>= number (caar ranges))
+		     (<= number (cdar ranges))))
+	  (setq not-stop nil))
+	(setq ranges (cdr ranges)))
+      (not not-stop))))
+
+(defun range-list-intersection (list ranges)
+  "Return a list of numbers in LIST that are members of RANGES.
+oLIST is a sorted list."
+  (setq ranges (range-normalize ranges))
+  (let (number result)
+    (while (setq number (pop list))
+      (while (and ranges
+		  (if (numberp (car ranges))
+		      (< (car ranges) number)
+		    (< (cdar ranges) number)))
+	(setq ranges (cdr ranges)))
+      (when (and ranges
+		 (if (numberp (car ranges))
+		     (= (car ranges) number)
+		   ;; (caar ranges) <= number <= (cdar ranges)
+		   (>= number (caar ranges))))
+	(push number result)))
+    (nreverse result)))
+
+(defun range-list-difference (list ranges)
+  "Return a list of numbers in LIST that are not members of RANGES.
+LIST is a sorted list."
+  (setq ranges (range-normalize ranges))
+  (let (number result)
+    (while (setq number (pop list))
+      (while (and ranges
+		  (if (numberp (car ranges))
+		      (< (car ranges) number)
+		    (< (cdar ranges) number)))
+	(setq ranges (cdr ranges)))
+      (when (or (not ranges)
+		(if (numberp (car ranges))
+		    (not (= (car ranges) number))
+		  ;; not ((caar ranges) <= number <= (cdar ranges))
+		  (< number (caar ranges))))
+	(push number result)))
+    (nreverse result)))
+
+(defun range-length (range)
+  "Return the length RANGE would have if uncompressed."
+  (cond
+   ((null range)
+    0)
+   ((not (listp (cdr range)))
+    (- (cdr range) (car range) -1))
+   (t
+    (let ((sum 0))
+      (dolist (x range sum)
+	(setq sum
+	      (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
+
+(defun range-concat (range1 range2)
+  "Add RANGE2 to RANGE1 (nondestructively)."
+  (unless (listp (cdr range1))
+    (setq range1 (list range1)))
+  (unless (listp (cdr range2))
+    (setq range2 (list range2)))
+  (let ((item1 (pop range1))
+	(item2 (pop range2))
+	range item selector)
+    (while (or item1 item2)
+      (setq selector
+	    (cond
+	     ((null item1) nil)
+	     ((null item2) t)
+	     ((and (numberp item1) (numberp item2)) (< item1 item2))
+	     ((numberp item1) (< item1 (car item2)))
+	     ((numberp item2) (< (car item1) item2))
+	     (t (< (car item1) (car item2)))))
+      (setq item
+	    (or
+	     (let ((tmp1 item) (tmp2 (if selector item1 item2)))
+	       (cond
+		((null tmp1) tmp2)
+		((null tmp2) tmp1)
+		((and (numberp tmp1) (numberp tmp2))
+		 (cond
+		  ((eq tmp1 tmp2) tmp1)
+		  ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
+		  ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
+		  (t nil)))
+		((numberp tmp1)
+		 (cond
+		  ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2)
+		  ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2)))
+		  ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1))
+		  (t nil)))
+		((numberp tmp2)
+		 (cond
+		  ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1)
+		  ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1)))
+		  ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2))
+		  (t nil)))
+		((< (1+ (cdr tmp1)) (car tmp2)) nil)
+		((< (1+ (cdr tmp2)) (car tmp1)) nil)
+		(t (cons (min (car tmp1) (car tmp2))
+			 (max (cdr tmp1) (cdr tmp2))))))
+	     (progn
+	       (if item (push item range))
+	       (if selector item1 item2))))
+      (if selector
+	  (setq item1 (pop range1))
+	(setq item2 (pop range2))))
+    (if item (push item range))
+    (reverse range)))
+
+(defun range-map (func range)
+  "Apply FUNC to each value contained by RANGE."
+  (setq range (range-normalize range))
+  (while range
+    (let ((span (pop range)))
+      (if (numberp span)
+          (funcall func span)
+        (let ((first (car span))
+              (last (cdr span)))
+          (while (<= first last)
+            (funcall func first)
+            (setq first (1+ first))))))))
+
+(provide 'range)
+
+;;; range.el ends here
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 4a9814b5daf..32a046e0fbd 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -731,6 +731,7 @@ Interactively, N is the prefix numeric argument, and defaults to
 1."
   (interactive "p")
   (let ((start (current-column))
+        (entry (tabulated-list-get-entry))
         (nb-cols (length tabulated-list-format))
         (col-nb 0)
         (total-width 0)
@@ -741,9 +742,14 @@ Interactively, N is the prefix numeric argument, and defaults to
       (if (> start
              (setq total-width
                    (+ total-width
-                      (setq col-width
-                            (cadr (aref tabulated-list-format
-                                        col-nb))))))
+                      (max (setq col-width
+                                 (cadr (aref tabulated-list-format
+                                             col-nb)))
+                           (string-width (aref entry col-nb)))
+                      (or (plist-get (nthcdr 3 (aref tabulated-list-format
+                                                     col-nb))
+                                     :pad-right)
+                          1))))
           (setq col-nb (1+ col-nb))
         (setq found t)
         (setf (cadr (aref tabulated-list-format col-nb))