From ec6286f10b1357e719fca90ffa87d254193fb60f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 12 Nov 2020 23:12:06 +0100 Subject: [PATCH] Make text-scale-mode optionally adjust the header line * lisp/face-remap.el (text-scale-remap-header-line-face): New buffer local variable. (text-scale-mode): Adjust header line if above variable is non-nil. (face-remap--clear-remappings, face-remap--remap-face): New defuns. * lisp/face-remap.el: Arrange to watch text-scale-mode-remapping. (text-scale--refresh): New function. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-mode): Use text-scale-remap-header-line. --- etc/NEWS | 12 ++++++++ lisp/emacs-lisp/tabulated-list.el | 1 + lisp/face-remap.el | 51 +++++++++++++++++++++++++------ 3 files changed, 55 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f21c4cb02c..a21d8f9dce 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1459,6 +1459,18 @@ mouse now pops up a TTY menu by default instead of running the command 'tmm-menubar'. To restore the old behavior, set the user option 'tty-menu-open-use-tmm' to non-nil. +** text-scale-mode + +--- +*** text-scale-mode can now adjust font size of the header line. +When the new buffer local variable 'text-scale-remap-header-line' +is non-nil, 'text-scale-adjust' will also scale the text in the header +line when displaying that buffer. + +This is useful for major modes that arrange their display in a tabular +form below the header line. It is enabled by default in +'tabulated-list-mode' and its derived modes. + ** xwidget-webkit mode *** New xwidget commands. diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 30577679f2..ae3ed055c5 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -767,6 +767,7 @@ tabulated-list-mode (setq-local revert-buffer-function #'tabulated-list-revert) (setq-local glyphless-char-display (tabulated-list-make-glyphless-char-display-table)) + (setq-local text-scale-remap-header-line t) ;; Avoid messing up the entries' display just because the first ;; column of the first entry happens to begin with a R2L letter. (setq bidi-paragraph-direction 'left-to-right) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 028269a4b0..20c7607408 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -229,6 +229,39 @@ text-scale-mode-lighter (defvar text-scale-mode-amount 0) (make-variable-buffer-local 'text-scale-mode-amount) +(defvar text-scale-remap-header-line nil + "If non-nil, also change font size of the header line.") +(make-variable-buffer-local 'text-scale-header-line) + +(defun text-scale--refresh (symbol newval operation where) + "Watcher for `text-scale-remap-header-line'. +See `add-variable-watcher'." + (when (and (eq symbol 'text-scale-remap-header-line) + (eq operation 'set) + text-scale-mode) + (with-current-buffer where + (let ((text-scale-remap-header-line newval)) + (text-scale-mode 1))))) +(add-variable-watcher 'text-scale-remap-header-line #'text-scale--refresh) + +(defun face-remap--clear-remappings () + (dolist (remapping + ;; This is a bit messy to stay backwards compatible. + ;; In the future, this can be simplified to just use + ;; `text-scale-mode-remapping'. + (if (consp (car-safe text-scale-mode-remapping)) + text-scale-mode-remapping + (list text-scale-mode-remapping))) + (face-remap-remove-relative remapping)) + (setq text-scale-mode-remapping nil)) + +(defun face-remap--remap-face (sym) + (push (face-remap-add-relative sym + :height + (expt text-scale-mode-step + text-scale-mode-amount)) + text-scale-mode-remapping)) + (define-minor-mode text-scale-mode "Minor mode for displaying buffer text in a larger/smaller font. @@ -240,19 +273,19 @@ text-scale-mode The `text-scale-increase', `text-scale-decrease', and `text-scale-set' functions may be used to interactively modify the variable `text-scale-mode-amount' (they also enable or -disable `text-scale-mode' as necessary)." +disable `text-scale-mode' as necessary). + +If `text-scale-remap-header-line' is non-nil, also change +the font size of the header line." :lighter (" " text-scale-mode-lighter) - (when text-scale-mode-remapping - (face-remap-remove-relative text-scale-mode-remapping)) + (face-remap--clear-remappings) (setq text-scale-mode-lighter (format (if (>= text-scale-mode-amount 0) "+%d" "%d") text-scale-mode-amount)) - (setq text-scale-mode-remapping - (and text-scale-mode - (face-remap-add-relative 'default - :height - (expt text-scale-mode-step - text-scale-mode-amount)))) + (when text-scale-mode + (face-remap--remap-face 'default) + (when text-scale-remap-header-line + (face-remap--remap-face 'header-line))) (force-window-update (current-buffer))) (defun text-scale-min-amount () -- 2.28.0