Skip to content

Instantly share code, notes, and snippets.

@rougier

rougier/echo-line.el

Created Aug 11, 2020
Embed
What would you like to do?
An extension of the echo area to display static messages (emacs)
;; -------------------------------------------------------------------
;; 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))
@schellj

This comment has been minimized.

Copy link

@schellj schellj commented Aug 17, 2020

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.

@rougier

This comment has been minimized.

Copy link
Owner Author

@rougier rougier commented Aug 18, 2020

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

@schellj

This comment has been minimized.

Copy link

@schellj schellj commented Aug 18, 2020

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.

@rougier

This comment has been minimized.

Copy link
Owner Author

@rougier rougier commented Aug 18, 2020

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

@schellj

This comment has been minimized.

Copy link

@schellj schellj commented Aug 18, 2020

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.