Function: ert--results-update-ewoc-hf

ert--results-update-ewoc-hf is a byte-compiled function defined in ert.el.gz.

Signature

(ert--results-update-ewoc-hf EWOC STATS)

Documentation

Update the header and footer of EWOC to show certain information from STATS.

Also sets ert--results-progress-bar-button-begin.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/ert.el.gz
(defun ert--results-update-ewoc-hf (ewoc stats)
  "Update the header and footer of EWOC to show certain information from STATS.

Also sets `ert--results-progress-bar-button-begin'."
  (let ((run-count (ert-stats-completed stats))
        (results-buffer (current-buffer))
        ;; Need to save buffer-local value.
        (font-lock font-lock-mode))
    (ewoc-set-hf
     ewoc
     ;; header
     (with-temp-buffer
       (insert "Selector: ")
       (ert--insert-human-readable-selector (ert--stats-selector stats))
       (insert "\n")
       (insert
        (format (concat "Passed:  %s\n"
                        "Failed:  %s\n"
                        "Skipped: %s\n"
                        "Total:   %s/%s\n\n")
                (ert--results-format-expected-unexpected
                 (ert--stats-passed-expected stats)
                 (ert--stats-passed-unexpected stats))
                (ert--results-format-expected-unexpected
                 (ert--stats-failed-expected stats)
                 (ert--stats-failed-unexpected stats))
                (ert-stats-skipped stats)
                run-count
                (ert-stats-total stats)))
       (insert
        (format "Started at:   %s\n"
                (ert--format-time-iso8601 (ert--stats-start-time stats))))
       ;; FIXME: This is ugly.  Need to properly define invariants of
       ;; the `stats' data structure.
       (let ((state (cond ((ert--stats-aborted-p stats) 'aborted)
                          ((ert--stats-current-test stats) 'running)
                          ((ert--stats-end-time stats) 'finished)
                          (t 'preparing))))
         (cl-ecase state
           (preparing
            (insert ""))
           (aborted
            (cond ((ert--stats-current-test stats)
                   (insert "Aborted during test: ")
                   (ert-insert-test-name-button
                    (ert-test-name (ert--stats-current-test stats))))
                  (t
                   (insert "Aborted."))))
           (running
            (cl-assert (ert--stats-current-test stats))
            (insert "Running test: ")
            (ert-insert-test-name-button (ert-test-name
                                          (ert--stats-current-test stats))))
           (finished
            (cl-assert (not (ert--stats-current-test stats)))
            (insert "Finished.")))
         (insert "\n")
         (if (ert--stats-end-time stats)
             (insert
              (format "%s%s\n"
                      (if (ert--stats-aborted-p stats)
                          "Aborted at:   "
                        "Finished at:  ")
                      (ert--format-time-iso8601 (ert--stats-end-time stats))))
           (insert "\n"))
         (insert "\n"))
       (let ((progress-bar-string (with-current-buffer results-buffer
                                    ert--results-progress-bar-string)))
         (let ((progress-bar-button-begin
                (insert-text-button progress-bar-string
                                    :type 'ert--results-progress-bar-button
                                    'face (or (and font-lock
                                                   (ert-face-for-stats stats))
                                              'button))))
           ;; The header gets copied verbatim to the results buffer,
           ;; and all positions remain the same, so
           ;; `progress-bar-button-begin' will be the right position
           ;; even in the results buffer.
           (with-current-buffer results-buffer
             (setq-local ert--results-progress-bar-button-begin
                         progress-bar-button-begin))))
       (insert "\n\n")
       (buffer-string))
     ;; footer
     ;;
     ;; We actually want an empty footer, but that would trigger a bug
     ;; in ewoc, sometimes clearing the entire buffer.  (It's possible
     ;; that this bug has been fixed since this has been tested; we
     ;; should test it again.)
     "\n")))