An extension of the echo area to display static messages (emacs)

echo-line.el

;; -------------------------------------------------------------------
;; An extension of the echo area to display static messages
;; Copyright 2020 Nicolas P. Rougier
;; -------------------------------------------------------------------
;; This file is not part of GNU Emacs.
;;
;; This program 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.
;;
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>
;; -------------------------------------------------------------------
(provide 'echo-line)

(require 'subr-x)

(defun echo-line-format ()
  "String to be appended at right of echo area."
  (propertize (format-mode-line "%l:%c") 'face 'face-faded))


(defun echo-line-message (orig-fun &rest args)
  "This enhanced message displays a regular message in the echo area
   and adds a specific text on the right part of the echo area. This
   is to be used as an advice."
  (let* ((right
          (concat
           ;; ! First space is a thin space, not a regular space
           ;; ! Last space needed to have truncated line
           " " (echo-line-format) " "
           ))
         (width (- (frame-width) (length right) 0))
         (msg (if (car args) (apply 'format-message args) ""))
         ;; Hack: The space for the split is a thin space, not a regular space
         ;; This way, we get rid of the added part if present (unless an actual
         ;; message uses a thin space.
         (msg (car (split-string msg " ")))
         (msg (string-trim msg))
         (left (truncate-string-to-width msg width nil nil "…"))
         (full (format (format "%%-%ds %%s" width) left right))
         )
    (if (active-minibuffer-window)
        ;; Regular log and display when minibuffer is active
        (apply orig-fun args)
      ;; Enhanced display
      (progn
        ;; Log actual message without echo
        (if message-log-max
            (let ((inhibit-message t)) (apply orig-fun (list msg))))
        ;; Display enhanced message without log
        (let ((message-truncate-lines t) (message-log-max nil))
          ;; (apply orig-fun (list full))
          (apply orig-fun (list (substring full 0 -1)))
         (set-display-table-slot
           (window-display-table (minibuffer-window))
           'truncation  (make-glyph-code (string-to-char (substring full -2))
                                         'face-faded))
          )
        ;; Set current message explicitely
        (setq current-message msg)))))


;; Install advice
(advice-add 'message :around #'echo-line-message)

;; Instal post-command hook
(add-hook 'post-command-hook
          (lambda () (let ((message-log-max nil))
                       (message (current-message)))))

;; Install a display table in minibuffer window
(set-window-display-table (minibuffer-window) (make-display-table))

FYI, there are issues with this when the actual message has a percent sign in it (or probably other format special characters).

Debugger entered--Lisp error: (error "Format string ends in middle of format specifier")
  #<subr message>("Scanning for dabbrevs...100%")
  apply(#<subr message> "Scanning for dabbrevs...100%")
  (let ((inhibit-message t)) (apply orig-fun (list msg)))
  (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg))))
  (progn (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg)))) (let ((message-truncate-lines t) (message-log-max nil)) (apply orig-fun (list (substring full 0 -1))) (set-display-table-slot (window-display-table (minibuffer-window)) 'truncation (make-glyph-code (string-to-char (substring full -2)) 'echo-line-face))) (setq current-message msg))
  (if (active-minibuffer-window) (apply orig-fun args) (progn (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg)))) (let ((message-truncate-lines t) (message-log-max nil)) (apply orig-fun (list (substring full 0 -1))) (set-display-table-slot (window-display-table (minibuffer-window)) 'truncation (make-glyph-code (string-to-char (substring full -2)) 'echo-line-face))) (setq current-message msg)))
  (let* ((right (concat " " (echo-line-format) " ")) (width (- (frame-width) (length right) 0)) (msg (if (car args) (apply 'format-message args) "")) (msg (car (split-string msg " "))) (msg (string-trim msg)) (left (truncate-string-to-width msg width nil nil "…")) (full (format (format "%%-%ds %%s" width) left right))) (if (active-minibuffer-window) (apply orig-fun args) (progn (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg)))) (let ((message-truncate-lines t) (message-log-max nil)) (apply orig-fun (list (substring full 0 -1))) (set-display-table-slot (window-display-table (minibuffer-window)) 'truncation (make-glyph-code (string-to-char (substring full -2)) 'echo-line-face))) (setq current-message msg))))
  echo-line-message(#<subr message> "%s%d%% %s" "Scanning for dabbrevs..." 100 "")
  apply(echo-line-message #<subr message> ("%s%d%% %s" "Scanning for dabbrevs..." 100 ""))
  message("%s%d%% %s" "Scanning for dabbrevs..." 100 "")
  progress-reporter-do-update((0 . [1597695508.947049 -39 0 "Scanning for dabbrevs..." 1 1.5 nil]) 0 nil)
  make-progress-reporter("Scanning for dabbrevs..." -39 0 0 1 1.5)
  dabbrev--find-expansion("ref_sh" 0 t)
  dabbrev-expand(nil)
  funcall-interactively(dabbrev-expand nil)
  call-interactively(dabbrev-expand nil nil)
  command-execute(dabbrev-expand)

Debugger entered--Lisp error: (error "Not enough arguments for format string")
  #<subr message>(#("Spell Checking...0% [GTService]" 21 30 (charset iso-8859-1)))
  apply(#<subr message> #("Spell Checking...0% [GTService]" 21 30 (charset iso-8859-1)))
  (let ((inhibit-message t)) (apply orig-fun (list msg)))
  (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg))))
  (progn (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg)))) (let ((message-truncate-lines t) (message-log-max nil)) (apply orig-fun (list (substring full 0 -1))) (set-display-table-slot (window-display-table (minibuffer-window)) 'truncation (make-glyph-code (string-to-char (substring full -2)) 'echo-line-face))) (setq current-message msg))
  (if (active-minibuffer-window) (apply orig-fun args) (progn (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg)))) (let ((message-truncate-lines t) (message-log-max nil)) (apply orig-fun (list (substring full 0 -1))) (set-display-table-slot (window-display-table (minibuffer-window)) 'truncation (make-glyph-code (string-to-char (substring full -2)) 'echo-line-face))) (setq current-message msg)))
  (let* ((right (concat " " (echo-line-format) " ")) (width (- (frame-width) (length right) 0)) (msg (if (car args) (apply 'format-message args) "")) (msg (car (split-string msg " "))) (msg (string-trim msg)) (left (truncate-string-to-width msg width nil nil "…")) (full (format (format "%%-%ds %%s" width) left right))) (if (active-minibuffer-window) (apply orig-fun args) (progn (if message-log-max (let ((inhibit-message t)) (apply orig-fun (list msg)))) (let ((message-truncate-lines t) (message-log-max nil)) (apply orig-fun (list (substring full 0 -1))) (set-display-table-slot (window-display-table (minibuffer-window)) 'truncation (make-glyph-code (string-to-char (substring full -2)) 'echo-line-face))) (setq current-message msg))))
  echo-line-message(#<subr message> "Spell Checking...%d%% [%s]" 0 #("GTService" 0 9 (charset iso-8859-1)))
  apply(echo-line-message #<subr message> ("Spell Checking...%d%% [%s]" 0 #("GTService" 0 9 (charset iso-8859-1))))
  message("Spell Checking...%d%% [%s]" 0 #("GTService" 0 9 (charset iso-8859-1)))
  flyspell-external-point-words()
  flyspell-large-region(1 15785)
  flyspell-region(1 15785)
  flyspell-buffer()
  funcall-interactively(flyspell-buffer)
  call-interactively(flyspell-buffer record nil)
  command-execute(flyspell-buffer record)
  counsel-M-x-action("flyspell-buffer")
  ivy-call()
  ivy-read("M-x " [eww-buffer-select connection-failed diary-included-files :forground locals copy-epl-upgrade :thumb_800 vc-git-stash-snapshot erc-menu-defined spaceline-info-mode-off-hook image-dired-update-property vterm-yank erc-readonly-mode-off-hook markdown-match-bold vc-git-make-version-backups-p mml-secure-smime-sign-with-sender url-cookie-multiple-line slack-unread-collapse-url gnus-agent-group-covered-p lsp--check-document-changes-version _message resourceOperations slack-message-event-processable-p slack-insert-keyword-mention cl-print--preprocess which-key-side-window-max-height hydra-dap :notifier wicon erc-log-match-format erc-away-nickname 0 :tooltip cperl-hook-after-change image-dired-cmd-rotate-thumbnail-options gnus-tree-buffer message-kill-actions nnheader-translate-file-chars container \' counsel-projectile-switch-to-buffer-transformer slack-counts-im-latest slack-room-pins-list + erc-cancel-timer alert--log-disable-messaging cperl-load-font-lock-keywords-1 cperl-load-font-lock-keywords-2 pkg-info--read-function calendar-debug-sexp ...] :predicate #f(compiled-function (sym) #<bytecode 0x1fe326a51aad>) :require-match t :history counsel-M-x-history :action counsel-M-x-action :keymap (keymap (67108908 . counsel--info-lookup-symbol) (67108910 . counsel-find-symbol)) :initial-input nil :caller counsel-M-x)
  counsel-M-x()
  funcall-interactively(counsel-M-x)
  call-interactively(counsel-M-x nil nil)
  command-execute(counsel-M-x)

Haven't had time to provide a fix for this myself yet.

Thanks for the report. Do you know when this happen?

The first backtrace happened when using dabbrev-expand and the second happened when using flyspell-buffer. Each command outputs a message that ends in %. I had run the code in the gist (without issue) before running those commands and running into the above errors.

Ok, thanks, I will try to debug it. In the menatime, you might be interested in mini-modeline

Thanks and thanks for the suggestion. I tried out mini-modeline, but decided not to use it because, as far as I could tell, it results in using minibuffer instead of the modeline, which isn't what I wanted; I wanted to use both the modeline and the minibuffer to display different information. I've found that I can do that with minibuffer-line, though.

I modified the code slightly to handle these (and other) issues. See here.