Merge remote-tracking branch 'savannah/master' into HEAD

7 files changed, 200 insertions, 126 deletions

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a376067443a..78461185d3a 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug property?"
 
 ;;; Offsets for reader
 
+(defun edebug-get-edebug-or-ghost (name)
+  "Get NAME's value of property `edebug' or property `ghost-edebug'.
+
+The idea is that should function NAME be recompiled whilst
+debugging is in progress, property `edebug' will get set to a
+marker.  The needed data will then come from property
+`ghost-edebug'."
+  (let ((e (get name 'edebug)))
+    (if (consp e)
+        e
+      (let ((g (get name 'ghost-edebug)))
+        (if (consp g)
+            g
+          e)))))
+
 ;; Define a structure to represent offset positions of expressions.
 ;; Each offset structure looks like: (before . after) for constituents,
 ;; or for structures that have elements: (before <subexpressions> . after)
@@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting
                 ;; Not edebugging this form, so reset the symbol's edebug
                 ;; property to be just a marker at the definition's source code.
                 ;; This only works for defs with simple names.
+
+                ;; Preserve the `edebug' property in case there's
+                ;; debugging still under way.
+                (let ((ghost (get def-name 'edebug)))
+                  (if (consp ghost)
+                      (put def-name 'ghost-edebug ghost)))
                 (put def-name 'edebug (point-marker))
                 ;; Also nil out dependent defs.
                 '(mapcar (function
@@ -1411,6 +1432,8 @@ contains a circular object."
 		  (cons window (window-start window)))))
 
       ;; Store the edebug data in symbol's property list.
+      ;; We actually want to remove this property entirely, but can't.
+      (put edebug-def-name 'ghost-edebug nil)
       (put edebug-def-name 'edebug
 	   ;; A struct or vector would be better here!!
 	   (list edebug-form-begin-marker
@@ -1423,8 +1446,8 @@ contains a circular object."
       )))
 
 (defun edebug--restore-breakpoints (name)
-  (let ((data (get name 'edebug)))
-    (when (listp data)
+  (let ((data (edebug-get-edebug-or-ghost name)))
+    (when (consp data)
       (let ((offsets (nth 2 data))
             (breakpoints (nth 1 data))
             (start (nth 0 data))
@@ -3128,7 +3151,7 @@ before returning.  The default is one second."
   ;; Return (function . index) of the nearest edebug stop point.
   (let* ((edebug-def-name (edebug-form-data-symbol))
 	 (edebug-data
-	   (let ((data (get edebug-def-name 'edebug)))
+	   (let ((data (edebug-get-edebug-or-ghost edebug-def-name)))
 	     (if (or (null data) (markerp data))
 		 (error "%s is not instrumented for Edebug" edebug-def-name))
 	     data))  ; we could do it automatically, if data is a marker.
@@ -3165,7 +3188,7 @@ before returning.  The default is one second."
     (if edebug-stop-point
 	(let* ((edebug-def-name (car edebug-stop-point))
 	       (index (cdr edebug-stop-point))
-	       (edebug-data (get edebug-def-name 'edebug))
+	       (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
 
 	       ;; pull out parts of edebug-data
 	       (edebug-def-mark (car edebug-data))
@@ -3206,7 +3229,7 @@ the breakpoint."
     (if edebug-stop-point
 	(let* ((edebug-def-name (car edebug-stop-point))
 	       (index (cdr edebug-stop-point))
-	       (edebug-data (get edebug-def-name 'edebug))
+	       (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
 
 	       ;; pull out parts of edebug-data
 	       (edebug-def-mark (car edebug-data))
@@ -3244,7 +3267,7 @@ the breakpoint."
   "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
 
 (defun edebug--overlay-breakpoints (function)
-  (let* ((data (get function 'edebug))
+  (let* ((data (edebug-get-edebug-or-ghost function))
          (start (nth 0 data))
          (breakpoints (nth 1 data))
          (offsets (nth 2 data)))
@@ -3284,9 +3307,9 @@ With prefix argument, make it a temporary breakpoint."
   (interactive "P")
   ;; If the form hasn't been instrumented yet, do it now.
   (when (and (not edebug-active)
-	     (let ((data (get (edebug--form-data-name
-                               (edebug-get-form-data-entry (point)))
-                              'edebug)))
+	     (let ((data (edebug-get-edebug-or-ghost
+                          (edebug--form-data-name
+                           (edebug-get-form-data-entry (point))))))
 	       (or (null data) (markerp data))))
     (edebug-defun))
   (edebug-modify-breakpoint t nil arg))
@@ -3300,7 +3323,7 @@ With prefix argument, make it a temporary breakpoint."
   "Unset all the breakpoints in the current form."
   (interactive)
   (let* ((name (edebug-form-data-symbol))
-         (breakpoints (nth 1 (get name 'edebug))))
+         (breakpoints (nth 1 (edebug-get-edebug-or-ghost name))))
     (unless breakpoints
       (user-error "There are no breakpoints in %s" name))
     (save-excursion
@@ -3316,7 +3339,7 @@ With prefix argument, make it a temporary breakpoint."
       (user-error "No stop point near point"))
     (let* ((name (car stop-point))
            (index (cdr stop-point))
-           (data (get name 'edebug))
+           (data (edebug-get-edebug-or-ghost name))
            (breakpoint (assq index (nth 1 data))))
       (unless breakpoint
         (user-error "No breakpoint near point"))
@@ -3497,7 +3520,7 @@ instrument cannot be found, signal an error."
 	(goto-char func-marker)
 	(edebug-eval-top-level-form)
         (list func)))
-     ((consp func-marker)
+     ((and (consp func-marker) (consp (symbol-function func)))
       (message "%s is already instrumented." func)
       (list func))
      (t
@@ -4270,7 +4293,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
   (let* ((index (backtrace-get-index))
          (frame (nth index backtrace-frames)))
     (when (edebug--frame-def-name frame)
-      (let* ((data (get (edebug--frame-def-name frame) 'edebug))
+      (let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame)))
              (marker (nth 0 data))
              (offsets (nth 2 data)))
         (pop-to-buffer (marker-buffer marker))
@@ -4354,7 +4377,7 @@ reinstrument it."
   (let* ((function (edebug-form-data-symbol))
 	 (counts (get function 'edebug-freq-count))
 	 (coverages (get function 'edebug-coverage))
-	 (data (get function 'edebug))
+	 (data (edebug-get-edebug-or-ghost function))
 	 (def-mark (car data))	; mark at def start
 	 (edebug-points (nth 2 data))
 	 (i (1- (length edebug-points)))
@@ -4512,7 +4535,7 @@ With prefix argument, make it a temporary breakpoint."
       (if edebug-stop-point
 	  (let* ((edebug-def-name (car edebug-stop-point))
 		 (index (cdr edebug-stop-point))
-		 (edebug-data (get edebug-def-name 'edebug))
+		 (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
 		 (edebug-breakpoints (car (cdr edebug-data)))
 		 (edebug-break-data (assq index edebug-breakpoints))
 		 (edebug-break-condition (car (cdr edebug-break-data)))
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 010a2b673e1..2cb1f614ce3 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -473,8 +473,7 @@ instance."
     (let* ((cfn (or file (oref this file)))
            (default-directory (file-name-directory cfn)))
       (cl-letf ((standard-output (current-buffer))
-                (inhibit-modification-hooks t)
-                ((oref this file) ;FIXME: Why change it?
+                ((oref this file)       ;FIXME: Why change it?
                  (if file
                      ;; FIXME: Makes a name relative to (oref this file),
                      ;; whereas I think it should be relative to cfn.
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 999d75f79e9..ee5dd2cccdb 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -351,21 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the
 contents of field NAME is matched against PAT, or they can be of
  the form NAME which is a shorthand for (NAME NAME)."
   (declare (debug (&rest [&or (sexp pcase-PAT) sexp])))
-  (let ((is (make-symbol "table")))
-    ;; FIXME: This generates a horrendous mess of redundant let bindings.
-    ;; `pcase' needs to be improved somehow to introduce let-bindings more
-    ;; sparingly, or the byte-compiler needs to be taught to optimize
-    ;; them away.
-    ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
-    ;; various branches.
-    `(and (pred eieio-object-p)
+  ;; FIXME: This generates a horrendous mess of redundant let bindings.
+  ;; `pcase' needs to be improved somehow to introduce let-bindings more
+  ;; sparingly, or the byte-compiler needs to be taught to optimize
+  ;; them away.
+  ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+  ;; various branches.
+  `(and (pred eieio-object-p)
         ,@(mapcar (lambda (field)
                     (pcase-exhaustive field
                       (`(,name ,pat)
-                        `(app (pcase--flip eieio-oref ',name) ,pat))
+                       `(app (pcase--flip eieio-oref ',name) ,pat))
                       ((pred symbolp)
                        `(app (pcase--flip eieio-oref ',field) ,field))))
-                  fields))))
+                  fields)))
 
 ;;; Simple generators, and query functions.  None of these would do
 ;;  well embedded into an object.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 4a2e7488eb0..ef5dbf8103f 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -5,6 +5,11 @@
 ;; Author: Noah Friedman <friedman@splode.com>
 ;; Keywords: extensions
 ;; Created: 1995-10-06
+;; Version: 1.0.0
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package.  Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
 
 ;; This file is part of GNU Emacs.
 
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 36b93fa7ac5..a8ce23284c4 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'.
            (seen '())
            (codegen
             (lambda (code vars)
-              (let ((prev (assq code seen)))
+              (let ((vars (pcase--fgrep vars code))
+                    (prev (assq code seen)))
                 (if (not prev)
                     (let ((res (pcase-codegen code vars)))
                       (push (list code vars res) seen)
@@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'.
                              (if (pcase--small-branch-p (cdr case))
                                  ;; Don't bother sharing multiple
                                  ;; occurrences of this leaf since it's small.
-                                 #'pcase-codegen codegen)
+                                 (lambda (code vars)
+                                   (pcase-codegen code
+                                                  (pcase--fgrep vars code)))
+                               codegen)
                              (cdr case)
                              vars))))
                      cases))))
@@ -687,14 +691,22 @@ MATCH is the pattern that needs to be matched, of the form:
           '(nil . :pcase--fail)
         '(:pcase--fail . nil))))))
 
-(defun pcase--fgrep (vars sexp)
-  "Check which of the symbols VARS appear in SEXP."
+(defun pcase--fgrep (bindings sexp)
+  "Return those of the BINDINGS which might be used in SEXP."
   (let ((res '()))
-    (while (consp sexp)
-      (dolist (var (pcase--fgrep vars (pop sexp)))
-        (unless (memq var res) (push var res))))
-    (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
-    res))
+    (while (and (consp sexp) bindings)
+      (dolist (binding (pcase--fgrep bindings (pop sexp)))
+        (push binding res)
+        (setq bindings (remove binding bindings))))
+    (if (vectorp sexp)
+        ;; With backquote, code can appear within vectors as well.
+        ;; This wouldn't be needed if we `macroexpand-all' before
+        ;; calling pcase--fgrep, OTOH.
+        (pcase--fgrep bindings (mapcar #'identity sexp))
+      (let ((tmp (assq sexp bindings)))
+        (if tmp
+            (cons tmp res)
+          res)))))
 
 (defun pcase--self-quoting-p (upat)
   (or (keywordp upat) (integerp upat) (stringp upat)))
@@ -734,13 +746,11 @@ MATCH is the pattern that needs to be matched, of the form:
   "Build a function call to FUN with arg ARG."
   (if (symbolp fun)
       `(,fun ,arg)
-    (let* (;; `vs' is an upper bound on the vars we need.
-           (vs (pcase--fgrep (mapcar #'car vars) fun))
-           (env (mapcar (lambda (var)
-                          (list var (cdr (assq var vars))))
-                        vs))
+    (let* (;; `env' is an upper bound on the bindings we need.
+           (env (mapcar (lambda (x) (list (car x) (cdr x)))
+                        (pcase--fgrep vars fun)))
            (call (progn
-                   (when (memq arg vs)
+                   (when (assq arg env)
                      ;; `arg' is shadowed by `env'.
                      (let ((newsym (gensym "x")))
                        (push (list newsym arg) env)
@@ -748,7 +758,7 @@ MATCH is the pattern that needs to be matched, of the form:
                    (if (functionp fun)
                        `(funcall #',fun ,arg)
                      `(,@fun ,arg)))))
-      (if (null vs)
+      (if (null env)
           call
         ;; Let's not replace `vars' in `fun' since it's
         ;; too difficult to do it right, instead just
@@ -759,10 +769,12 @@ MATCH is the pattern that needs to be matched, of the form:
   "Build an expression that will evaluate EXP."
   (let* ((found (assq exp vars)))
     (if found (cdr found)
-      (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
-             (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
-                          vs)))
-        (if env (macroexp-let* env exp) exp)))))
+      (let* ((env (pcase--fgrep vars exp)))
+        (if env
+            (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
+                                   env)
+                           exp)
+          exp)))))
 
 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
 ;; bootstrapping problems.
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 11cc1988b1f..46dc8d9ade8 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -63,9 +63,10 @@ override the buffer's syntax table for special syntactic constructs that
 cannot be handled just by the buffer's syntax-table.
 
 The specified function may call `syntax-ppss' on any position
-before END, but it should not call `syntax-ppss-flush-cache',
-which means that it should not call `syntax-ppss' on some
-position and later modify the buffer on some earlier position.")
+before END, but if it calls `syntax-ppss' on some
+position and later modifies the buffer on some earlier position,
+then it is its responsability to call `syntax-ppss-flush-cache' to flush
+the now obsolete ppss info from the cache.")
 
 (defvar syntax-propertize-chunk-size 500)
 
@@ -320,6 +321,11 @@ END) suitable for `syntax-propertize-function'."
 (defvar-local syntax-ppss-table nil
   "Syntax-table to use during `syntax-ppss', if any.")
 
+(defvar-local syntax-propertize--inhibit-flush nil
+  "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache.
+Otherwise it flushes both the ppss cache and the properties
+set by `syntax-propertize'")
+
 (defun syntax-propertize (pos)
   "Ensure that syntax-table properties are set until POS (a buffer point)."
   (when (< syntax-propertize--done pos)
@@ -345,23 +351,27 @@ END) suitable for `syntax-propertize-function'."
                    (end (max pos
                              (min (point-max)
                                   (+ start syntax-propertize-chunk-size))))
-                   (funs syntax-propertize-extend-region-functions))
-              (while funs
-                (let ((new (funcall (pop funs) start end))
-                      ;; Avoid recursion!
-                      (syntax-propertize--done most-positive-fixnum))
-                  (if (or (null new)
-                          (and (>= (car new) start) (<= (cdr new) end)))
-                      nil
-                    (setq start (car new))
-                    (setq end (cdr new))
-                    ;; If there's been a change, we should go through the
-                    ;; list again since this new position may
-                    ;; warrant a different answer from one of the funs we've
-                    ;; already seen.
-                    (unless (eq funs
-                                (cdr syntax-propertize-extend-region-functions))
-                      (setq funs syntax-propertize-extend-region-functions)))))
+                   (first t)
+                   (repeat t))
+              (while repeat
+                (setq repeat nil)
+                (run-hook-wrapped
+                 'syntax-propertize-extend-region-functions
+                 (lambda (f)
+                   (let ((new (funcall f start end))
+                         ;; Avoid recursion!
+                         (syntax-propertize--done most-positive-fixnum))
+                     (if (or (null new)
+                             (and (>= (car new) start) (<= (cdr new) end)))
+                         nil
+                       (setq start (car new))
+                       (setq end (cdr new))
+                       ;; If there's been a change, we should go through the
+                       ;; list again since this new position may
+                       ;; warrant a different answer from one of the funs we've
+                       ;; already seen.
+                       (unless first (setq repeat t))))
+                   (setq first nil))))
               ;; Flush ppss cache between the original value of `start' and that
               ;; set above by syntax-propertize-extend-region-functions.
               (syntax-ppss-flush-cache start)
@@ -371,8 +381,13 @@ END) suitable for `syntax-propertize-function'."
               ;; (message "syntax-propertizing from %s to %s" start end)
               (remove-text-properties start end
                                       '(syntax-table nil syntax-multiline nil))
-              ;; Avoid recursion!
-              (let ((syntax-propertize--done most-positive-fixnum))
+              ;; Make sure we only let-bind it buffer-locally.
+              (make-local-variable 'syntax-propertize--inhibit-flush)
+              ;; Let-bind `syntax-propertize--done' to avoid infinite recursion!
+              (let ((syntax-propertize--done most-positive-fixnum)
+                    ;; Let `syntax-propertize-function' call
+                    ;; `syntax-ppss-flush-cache' without worries.
+                    (syntax-propertize--inhibit-flush t))
                 (funcall syntax-propertize-function start end)))))))))
 
 ;;; Link syntax-propertize with syntax.c.
@@ -451,7 +466,8 @@ These are valid when the buffer has no restriction.")
 (defun syntax-ppss-flush-cache (beg &rest ignored)
   "Flush the cache of `syntax-ppss' starting at position BEG."
   ;; Set syntax-propertize to refontify anything past beg.
-  (setq syntax-propertize--done (min beg syntax-propertize--done))
+  (unless syntax-propertize--inhibit-flush
+    (setq syntax-propertize--done (min beg syntax-propertize--done)))
   ;; Flush invalid cache entries.
   (dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
     (pcase cell
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 4cebd739c3b..00d09696d2a 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -32,41 +32,49 @@
   "List all timers in a buffer."
   (interactive)
   (pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
-  (let ((inhibit-read-only t))
-    (erase-buffer)
-    (timer-list-mode)
-    (dolist (timer (append timer-list timer-idle-list))
-      (insert (format "%4s %10s %8s %s"
-                      ;; Idle.
-                      (if (aref timer 7) "*" " ")
-                      ;; Next time.
-		      (let ((time (list (aref timer 1)
-					(aref timer 2)
-					(aref timer 3))))
-                        (format "%.2f"
-				(float-time
-				 (if (aref timer 7)
-				     time
-				   (time-subtract time nil)))))
-                      ;; Repeat.
-                      (let ((repeat (aref timer 4)))
-                        (cond
-                         ((numberp repeat)
-                          (format "%.1f" repeat))
-                         ((null repeat)
-                          "-")
-                         (t
-                          (format "%s" repeat))))
-                      ;; Function.
-                      (let ((cl-print-compiled 'static)
-                            (cl-print-compiled-button nil)
-                            (print-escape-newlines t))
-                        (cl-prin1-to-string (aref timer 5)))))
-      (put-text-property (line-beginning-position)
-                         (1+ (line-beginning-position))
-                         'timer timer)
-      (insert "\n")))
-  (goto-char (point-min)))
+  (timer-list-mode)
+  (tabulated-list-init-header)
+  (setq tabulated-list-entries
+        (mapcar
+         (lambda (timer)
+           (list
+            nil
+            `[ ;; Idle.
+              ,(propertize
+                (if (aref timer 7) "   *" " ")
+                'help-echo "* marks idle timers"
+                'timer timer)
+              ;; Next time.
+              ,(propertize
+                (let ((time (list (aref timer 1)
+				  (aref timer 2)
+				  (aref timer 3))))
+                  (format "%10.2f"
+			  (float-time
+			   (if (aref timer 7)
+			       time
+			     (time-subtract time nil)))))
+                'help-echo "Time in sec till next invocation")
+              ;; Repeat.
+              ,(propertize
+                (let ((repeat (aref timer 4)))
+                  (cond
+                   ((numberp repeat)
+                    (format "%8.1f" repeat))
+                   ((null repeat)
+                    "       -")
+                   (t
+                    (format "%8s" repeat))))
+                'help-echo "Symbol: repeat; number: repeat interval in sec")
+              ;; Function.
+              ,(propertize
+                (let ((cl-print-compiled 'static)
+                      (cl-print-compiled-button nil)
+                      (print-escape-newlines t))
+                  (cl-prin1-to-string (aref timer 5)))
+                'help-echo "Function called by timer")]))
+         (append timer-list timer-idle-list)))
+  (tabulated-list-print))
 ;; This command can be destructive if they don't know what they are
 ;; doing.  Kids, don't try this at home!
 ;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
@@ -74,35 +82,47 @@
 (defvar timer-list-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'timer-list-cancel)
-    (define-key map "n" 'next-line)
-    (define-key map "p" 'previous-line)
     (easy-menu-define nil map ""
       '("Timers"
 	["Cancel" timer-list-cancel t]))
     map))
 
-(define-derived-mode timer-list-mode special-mode "Timer-List"
+(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List"
   "Mode for listing and controlling timers."
-  (setq bidi-paragraph-direction 'left-to-right)
-  (setq truncate-lines t)
   (buffer-disable-undo)
   (setq-local revert-buffer-function #'list-timers)
-  (setq buffer-read-only t)
-  (setq header-line-format
-        (concat (propertize " " 'display '(space :align-to 0))
-                (format "%4s %10s %8s %s"
-                        (propertize "Idle"
-                                    'mouse-face 'highlight
-                                    'help-echo "* marks idle timers")
-                        (propertize "Next"
-                                    'mouse-face 'highlight
-                                    'help-echo "Time in sec till next invocation")
-                        (propertize "Repeat"
-                                    'mouse-face 'highlight
-                                    'help-echo "Symbol: repeat; number: repeat interval in sec")
-                        (propertize "Function"
-                                    'mouse-face 'highlight
-                                    'help-echo "Function called by timer")))))
+  (setq tabulated-list-format
+        '[("Idle" 6 timer-list--idle-predicate)
+          ("      Next" 12 timer-list--next-predicate)
+          ("  Repeat" 11 timer-list--repeat-predicate)
+          ("Function" 10 timer-list--function-predicate)]))
+
+(defun timer-list--idle-predicate (A B)
+  "Predicate to sort Timer-List by the Idle column."
+  (let ((iA (aref (cadr A) 0))
+        (iB (aref (cadr B) 0)))
+    (cond ((string= iA iB)
+           (timer-list--next-predicate A B))
+          ((string= iA "   *") nil)
+          (t t))))
+
+(defun timer-list--next-predicate (A B)
+  "Predicate to sort Timer-List by the Next column."
+  (let ((nA (string-to-number (aref (cadr A) 1)))
+        (nB (string-to-number (aref (cadr B) 1))))
+    (< nA nB)))
+
+(defun timer-list--repeat-predicate (A B)
+  "Predicate to sort Timer-List by the Repeat column."
+  (let ((rA (aref (cadr A) 2))
+        (rB (aref (cadr B) 2)))
+    (string< rA rB)))
+
+(defun timer-list--function-predicate (A B)
+  "Predicate to sort Timer-List by the Next column."
+  (let ((fA (aref (cadr A) 3))
+        (fB (aref (cadr B) 3)))
+    (string< fA fB)))
 
 (defun timer-list-cancel ()
   "Cancel the timer on the line under point."