From e0488f89d1712ce905f9040e6b26fdf0a4a0666d Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 2 Jul 2022 15:40:45 +0200 Subject: [PATCH] Command for global adjustments to the default face * lisp/face-remap.el (global-text-scale-adjust): New command. (text-scale-adjust): Refer to the new related command. (global-text-scale-adjust-resizes-frames): New user option. * lisp/mwheel.el (mouse-wheel-scroll-amount): Add the new command to the mouse wheel scrolling events. (mouse-wheel-global-text-scale): New function. (mouse-wheel-mode): Use the new function with mouse-wheel-mode. * doc/emacs/display.texi (Text Scale): Document the new command and the new user option. * etc/NEWS: Mention the new command and its bindings, and the new user option. --- doc/emacs/display.texi | 16 +++++++++ etc/NEWS | 12 +++++++ lisp/face-remap.el | 80 +++++++++++++++++++++++++++++++++++++++++- lisp/mwheel.el | 20 ++++++++++- 4 files changed, 126 insertions(+), 2 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index fbff1d4eb69..5e4728c8da9 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -893,6 +893,22 @@ of 1.2; to change this factor, customize the variable to the @code{text-scale-adjust} command restores the default height, the same as typing @kbd{C-x C-0}. +@cindex ajust global font size +@findex global-text-scale-adjust +@kindex C-x C-M-+ +@kindex C-x C-M-= +@kindex C-x C-M-- +@kindex C-x C-M-0 +@kindex C-M-wheel-down +@kindex C-M-wheel-up + Similarly, to change the sizes of the fonts globally, type @kbd{C-x +C-M-+}, @kbd{C-x C-M-=}, @kbd{C-x C-M--} or @kbd{C-x C-M-0}, or scroll +the mouse wheel with both the @kbd{Ctrl} and @kbd{Meta} modifiers +pressed. To enable frame resizing when the font size is changed +globally, customize the variable +@code{global-text-scale-adjust-resizes-frames} (@pxref{Easy +Customization}). + @cindex increase buffer font size @findex text-scale-increase @cindex decrease buffer font size diff --git a/etc/NEWS b/etc/NEWS index 4b3a02b2e00..773e0849c2e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -324,6 +324,18 @@ startup. Previously, these functions ignored * Changes in Emacs 29.1 ++++ +** New command to change the fond sized globally. +To increase the font size, type 'C-x C-M-+' or 'C-x C-M-='; to +decrease it, type 'C-x C-M--'; to restore the font size, type 'C-x +C-M-0'. The final key in these commands may be repeated without the +leading 'C-x' and without the modifiers, e.g. 'C-x C-M-+ C-M-+ C-M-+' +and 'C-x C-M-+ + +' increase the font size by three steps. When +mouse-wheel-mode is enabled, 'C-M-wheel-up' and 'C-M-wheel-down' also +increase and decrease the font size globally. Additionally, the +variable 'global-text-scale-adjust-resizes-frames' controls whether +the frames are resized when the font size is changed. + ** New config variable 'syntax-wholeline-max' to reduce the cost of long lines. This variable is used by some operations (mostly syntax-propertization and font-locking) to treat lines longer than this variable as if they diff --git a/lisp/face-remap.el b/lisp/face-remap.el index d6116714082..bfc138b043f 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -394,7 +394,9 @@ a top-level keymap, `text-scale-increase' or Most faces are affected by these font size changes, but not faces that have an explicit `:height' setting. The two exceptions to this are the `default' and `header-line' faces: they will both be -scaled even if they have an explicit `:height' setting." +scaled even if they have an explicit `:height' setting. + +See also the related command `global-text-scale-adjust'." (interactive "p") (let ((ev last-command-event) (echo-keystrokes nil)) @@ -445,6 +447,82 @@ scaled even if they have an explicit `:height' setting." (+ text-scale--pinch-start-scale (round (log scale text-scale-mode-step))))))) +(defcustom global-text-scale-adjust-resizes-frames nil + "Whether `global-text-scale-adjust' resizes the frames." + :type '(choice (const :tag "Off" nil) + (const :tag "On" t)) + :group 'display + :version "28.1") + +(defcustom global-text-scale-adjust-limits '(10 . 500) + "Min/max values for `global-text-scale-adjust'. +This is a cons cell where the `car' has the minimum font size and +the `cdr' has the max font size." + :version "29.1" + :group 'display + :type '(cons (integer :tag "Min") + (integer :tag "Max"))) + +(defvar global-text-scale-adjust--default-height nil) + +;;;###autoload (define-key ctl-x-map [(control meta ?+)] 'global-text-scale-adjust) +;;;###autoload (define-key ctl-x-map [(control meta ?=)] 'global-text-scale-adjust) +;;;###autoload (define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust) +;;;###autoload (define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust) +;;;###autoload +(defun global-text-scale-adjust (increment) + "Globally adjust the font size by INCREMENT. + +Interactively, INCREMENT may be passed as a numeric prefix argument. + +The adjustment made depends on the final component of the key binding +used to invoke the command, with all modifiers removed: + + +, = Globally increase the height of the default face + - Globally decrease the height of the default face + 0 Globally reset the height of the default face + +After adjusting, further adjust the font size as long as the key, +with all modifiers removed, is one of the above characters. + +Buffer-local face adjustements have higher priority than global +face adjustments. + +The variable `global-text-scale-adjust-resizes-frames' controls +whether the frames are resized to keep the same number of lines +and characters per line when the font size is adjusted. + +See also the related command `text-scale-adjust'." + (interactive "p") + (when (display-graphic-p) + (unless global-text-scale-adjust--default-height + (setq global-text-scale-adjust--default-height + (face-attribute 'default :height))) + (let* ((key (event-basic-type last-command-event)) + (echo-keystrokes nil) + (cur (face-attribute 'default :height)) + (inc + (pcase key + (?- (* (- increment) 5)) + (?0 (- global-text-scale-adjust--default-height cur)) + (_ (* increment 5)))) + (new (+ cur inc))) + (when (< (car global-text-scale-adjust-limits) + new + (cdr global-text-scale-adjust-limits)) + (let ((frame-inhibit-implied-resize + (not global-text-scale-adjust-resizes-frames))) + (set-face-attribute 'default nil :height new))) + (when (characterp key) + (message "Use +,-,0 for further adjustment") + (set-transient-map + (let ((map (make-sparse-keymap))) + (dolist (mod '(() (control meta))) + (dolist (key '(?+ ?= ?- ?0)) + (define-key map (vector (append mod (list key))) + 'global-text-scale-adjust))) + map)))))) + ;; ---------------------------------------------------------------- ;; buffer-face-mode diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 9a92d42cc00..7963eaf4a45 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -41,6 +41,17 @@ (require 'timer) (defvar mouse-wheel-mode) + +(defun mouse-wheel-global-text-scale (event) + "Increase or decrease the global font size according to the EVENT." + (interactive (list last-input-event)) + (let ((button (mwheel-event-button event))) + (unwind-protect + (cond ((eq button mouse-wheel-down-event) + (global-text-scale-adjust 1)) + ((eq button mouse-wheel-up-event) + (global-text-scale-adjust -1)))))) + (defvar mouse-wheel--installed-bindings-alist nil "Alist of all installed mouse wheel key bindings.") @@ -113,7 +124,10 @@ set to the event sent when clicking on the mouse wheel button." :type 'number) (defcustom mouse-wheel-scroll-amount - '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale)) + '(1 ((shift) . hscroll) + ((meta) . nil) + ((control meta) . global-text-scale) + ((control) . text-scale)) "Amount to scroll windows by when spinning the mouse wheel. This is an alist mapping the modifier key to the amount to scroll when the wheel is moved with the modifier key depressed. @@ -489,6 +503,10 @@ an event used for scrolling, such as `mouse-wheel-down-event'." (when event (mouse-wheel--add-binding `[,(list (caar binding) event)] 'mouse-wheel-text-scale)))) + ((and (consp binding) (eq (cdr binding) 'global-text-scale)) + (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) + (mouse-wheel--add-binding `[,(append (car binding) (list event))] + 'mouse-wheel-global-text-scale))) ;; Bindings for scrolling. (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event -- 2.39.2