X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1259009aa17da6dc038afff96963f6d9bbd3b8e1..a8e1414c0d66903884059361ecc8ec70da37cf35:/lisp/face-remap.el?ds=sidebyside diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 146cea80a9..9c2cae14b3 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -1,6 +1,6 @@ -;;; face-remap.el --- Functions for managing `face-remapping-alist' +;;; face-remap.el --- Functions for managing `face-remapping-alist' -*- lexical-binding: t -*- ;; -;; Copyright (C) 2008-2012 Free Software Foundation, Inc. +;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; ;; Author: Miles Bader ;; Keywords: faces, face remapping, display, user commands @@ -72,7 +72,7 @@ :font :inherit :fontset :vector]) (defun face-attrs-more-relative-p (attrs1 attrs2) -"Return true if ATTRS1 contains a greater number of relative + "Return true if ATTRS1 contains a greater number of relative face-attributes than ATTRS2. A face attribute is considered relative if `face-attribute-relative-p' returns non-nil. @@ -106,21 +106,25 @@ The list structure of ENTRY may be destructively modified." ;;;###autoload (defun face-remap-add-relative (face &rest specs) "Add a face remapping entry of FACE to SPECS in the current buffer. - -Return a cookie which can be used to delete the remapping with +Return a cookie which can be used to delete this remapping with `face-remap-remove-relative'. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute -property list. The attributes given by SPECS will be merged with -any other currently active face remappings of FACE, and with the -global definition of FACE. An attempt is made to sort multiple -entries so that entries with relative face-attributes are applied -after entries with absolute face-attributes. - -The base (lowest priority) remapping may be set to a specific -value, instead of the default of the global face definition, -using `face-remap-set-base'." +The remaining arguments, SPECS, should form a list of faces. +Each list element should be either a face name or a property list +of face attribute/value pairs. If more than one face is listed, +that specifies an aggregate face, in the same way as in a `face' +text property, except for possible priority changes noted below. + +The face remapping specified by SPECS takes effect alongside the +remappings from other calls to `face-remap-add-relative' for the +same FACE, as well as the normal definition of FACE (at lowest +priority). This function tries to sort multiple remappings for +the same face, so that remappings specifying relative face +attributes are applied after remappings specifying absolute face +attributes. + +The base (lowest priority) remapping may be set to something +other than the normal definition of FACE via `face-remap-set-base'." (while (and (consp specs) (null (cdr specs))) (setq specs (car specs))) (make-local-variable 'face-remapping-alist) @@ -128,7 +132,12 @@ using `face-remap-set-base'." (when (null entry) (setq entry (list face face)) ; explicitly merge with global def (push entry face-remapping-alist)) - (setcdr entry (face-remap-order (cons specs (cdr entry)))) + (let ((faces (cdr entry))) + (if (symbolp faces) + (setq faces (list faces))) + (setcdr entry (face-remap-order (cons specs faces))) + ;; Force redisplay of this buffer. + (force-mode-line-update)) (cons face specs))) (defun face-remap-remove-relative (cookie) @@ -143,12 +152,16 @@ COOKIE should be the return value from that function." (and (eq (car-safe updated-entries) (car cookie)) (null (cdr updated-entries)))) (setq face-remapping-alist - (remq remapping face-remapping-alist))) + (remq remapping face-remapping-alist)) + ;; Force redisplay of this buffer. + (force-mode-line-update)) (cdr cookie)))))) ;;;###autoload (defun face-remap-reset-base (face) - "Set the base remapping of FACE to inherit from FACE's global definition." + "Set the base remapping of FACE to the normal definition of FACE. +This causes the remappings specified by `face-remap-add-relative' +to apply on top of the normal definition of FACE." (let ((entry (assq face face-remapping-alist))) (when entry ;; If there's nothing except a base remapping, we simply remove @@ -158,15 +171,24 @@ COOKIE should be the return value from that function." (if (null (cddr entry)) ; nothing except base remapping (setq face-remapping-alist ; so remove entire entry (remq entry face-remapping-alist)) - (setcar (last entry) face))))) ; otherwise, just inherit global def + (setcar (last entry) face)) + ;; Force redisplay of this buffer. + (force-mode-line-update)))) ; otherwise, just inherit global def ;;;###autoload (defun face-remap-set-base (face &rest specs) "Set the base remapping of FACE in the current buffer to SPECS. -If SPECS is empty, the default base remapping is restored, which -inherits from the global definition of FACE; note that this is -different from SPECS containing a single value `nil', which does -not inherit from the global definition of FACE." +This causes the remappings specified by `face-remap-add-relative' +to apply on top of the face specification given by SPECS. + +The remaining arguments, SPECS, should form a list of faces. +Each list element should be either a face name or a property list +of face attribute/value pairs, like in a `face' text property. + +If SPECS is empty, call `face-remap-reset-base' to use the normal +definition of FACE as the base remapping; note that this is +different from SPECS containing a single value nil, which means +not to inherit from the global definition of FACE at all." (while (and (consp specs) (not (null (car specs))) (null (cdr specs))) (setq specs (car specs))) (if (or (null specs) @@ -178,7 +200,9 @@ not inherit from the global definition of FACE." (let ((entry (assq face face-remapping-alist))) (if entry (setcar (last entry) specs) ; overwrite existing base entry - (push (list face specs) face-remapping-alist))))) + (push (list face specs) face-remapping-alist))) + ;; Force redisplay of this buffer. + (force-mode-line-update))) ;; ---------------------------------------------------------------- @@ -205,6 +229,9 @@ Each positive or negative step scales the default face height by this amount." (define-minor-mode text-scale-mode "Minor mode for displaying buffer text in a larger/smaller font. +With a prefix argument ARG, enable the mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. The amount of scaling is determined by the variable `text-scale-mode-amount': one step scales the global default @@ -229,6 +256,23 @@ disable `text-scale-mode' as necessary)." text-scale-mode-amount)))) (force-window-update (current-buffer))) +(defun text-scale-min-amount () + "Return the minimum amount of text-scaling we allow." + ;; When the resulting pixel-height of characters will become smaller + ;; than 1 pixel, we can expect trouble from the display engine. + ;; E.g., it requires that the character glyph's ascent is + ;; non-negative. + (log (/ 1.0 (frame-char-height)) text-scale-mode-step)) + +(defun text-scale-max-amount () + "Return the maximum amount of text-scaling we allow." + ;; The display engine uses a 16-bit short for pixel-width of + ;; characters, thus the 0xffff limitation. It also makes no sense + ;; to have characters wider than the display. + (log (/ (min (display-pixel-width) #xffff) + (frame-char-width)) + text-scale-mode-step)) + ;;;###autoload (defun text-scale-set (level) "Set the scale factor of the default face in the current buffer to LEVEL. @@ -239,7 +283,8 @@ Each step scales the height of the default face by the variable `text-scale-mode-step' (a negative number decreases the height by the same amount)." (interactive "p") - (setq text-scale-mode-amount level) + (setq text-scale-mode-amount + (max (min level (text-scale-max-amount)) (text-scale-min-amount))) (text-scale-mode (if (zerop text-scale-mode-amount) -1 1))) ;;;###autoload @@ -252,8 +297,13 @@ Each step scales the height of the default face by the variable height by the same amount). As a special case, an argument of 0 will remove any scaling currently active." (interactive "p") - (setq text-scale-mode-amount - (if (= inc 0) 0 (+ (if text-scale-mode text-scale-mode-amount 0) inc))) + (let* ((current-value (if text-scale-mode text-scale-mode-amount 0)) + (new-value (if (= inc 0) 0 (+ current-value inc)))) + (if (or (> new-value (text-scale-max-amount)) + (< new-value (text-scale-min-amount))) + (user-error "Cannot %s the default face height more than it already is" + (if (> inc 0) "increase" "decrease"))) + (setq text-scale-mode-amount new-value)) (text-scale-mode (if (zerop text-scale-mode-amount) -1 1))) ;;;###autoload @@ -269,7 +319,9 @@ See `text-scale-increase' for more details." ;;;###autoload (define-key ctl-x-map [(control ?0)] 'text-scale-adjust) ;;;###autoload (defun text-scale-adjust (inc) - "Increase or decrease the height of the default face in the current buffer. + "Adjust the height of the default face by INC. + +INC may be passed as a numeric prefix argument. The actual adjustment made depends on the final component of the key-binding used to invoke the command, with all modifiers removed: @@ -278,9 +330,9 @@ key-binding used to invoke the command, with all modifiers removed: - Decrease the default face height by one step 0 Reset the default face height to the global default -Then, continue to read input events and further adjust the face -height as long as the input event read (with all modifiers removed) -is one of the above. +After adjusting, continue to read input events and further adjust +the face height as long as the input event read +\(with all modifiers removed) is one of the above characters. Each step scales the height of the default face by the variable `text-scale-mode-step' (a negative number of steps decreases the @@ -293,27 +345,25 @@ even when it is bound in a non-top-level keymap. For binding in a top-level keymap, `text-scale-increase' or `text-scale-decrease' may be more appropriate." (interactive "p") - (let ((first t) - (step t) - (ev last-command-event) + (let ((ev last-command-event) (echo-keystrokes nil)) - (while step - (let ((base (event-basic-type ev))) - (cond ((or (eq base ?+) (eq base ?=)) - (setq step inc)) - ((eq base ?-) - (setq step (- inc))) - ((eq base ?0) - (setq step 0)) - (first - (setq step inc)) - (t - (setq step nil)))) - (when step - (text-scale-increase step) - (setq inc 1 first nil) - (setq ev (read-event "+,-,0 for further adjustment: ")))) - (push ev unread-command-events))) + (let* ((base (event-basic-type ev)) + (step + (pcase base + ((or ?+ ?=) inc) + (?- (- inc)) + (?0 0) + (_ inc)))) + (text-scale-increase step) + ;; (unless (zerop step) + (message "Use +,-,0 for further adjustment") + (set-transient-map + (let ((map (make-sparse-keymap))) + (dolist (mods '(() (control))) + (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +. + (define-key map (vector (append mods (list key))) + (lambda () (interactive) (text-scale-adjust (abs inc)))))) + map))))) ;; ) ;; ---------------------------------------------------------------- @@ -324,6 +374,9 @@ a top-level keymap, `text-scale-increase' or It may contain any value suitable for a `face' text property, including a face name, a list of face names, a face-attribute plist, etc." + :type '(choice (face) + (repeat :tag "List of faces" face) + (plist :tag "Face property list")) :group 'display :version "23.1") @@ -334,8 +387,10 @@ plist, etc." ;;;###autoload (define-minor-mode buffer-face-mode "Minor mode for a buffer-specific default face. -When enabled, the face specified by the variable -`buffer-face-mode-face' is used to display the buffer text." +With a prefix argument ARG, enable the mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. When enabled, the face specified by the +variable `buffer-face-mode-face' is used to display the buffer text." :lighter " BufFace" (when buffer-face-mode-remapping (face-remap-remove-relative buffer-face-mode-remapping)) @@ -347,13 +402,15 @@ When enabled, the face specified by the variable ;;;###autoload (defun buffer-face-set (&rest specs) "Enable `buffer-face-mode', using face specs SPECS. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute -If SPECS is nil, then `buffer-face-mode' is disabled. - -This function will make the variable `buffer-face-mode-face' -buffer local, and set it to FACE." - (interactive (list (read-face-name "Set buffer face"))) +Each argument in SPECS should be a face, i.e. either a face name +or a property list of face attributes and values. If more than +one face is listed, that specifies an aggregate face, like in a +`face' text property. If SPECS is nil or omitted, disable +`buffer-face-mode'. + +This function makes the variable `buffer-face-mode-face' buffer +local, and sets it to FACE." + (interactive (list (read-face-name "Set buffer face" (face-at-point t)))) (while (and (consp specs) (null (cdr specs))) (setq specs (car specs))) (if (null specs) @@ -364,13 +421,15 @@ buffer local, and set it to FACE." ;;;###autoload (defun buffer-face-toggle (&rest specs) "Toggle `buffer-face-mode', using face specs SPECS. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute +Each argument in SPECS should be a face, i.e. either a face name +or a property list of face attributes and values. If more than +one face is listed, that specifies an aggregate face, like in a +`face' text property. If `buffer-face-mode' is already enabled, and is currently using -the face specs SPECS, then it is disabled; if buffer-face-mode is -disabled, or is enabled and currently displaying some other face, -then is left enabled, but the face changed to reflect SPECS. +the face specs SPECS, then it is disabled; if `buffer-face-mode' +is disabled, or is enabled and currently displaying some other +face, then is left enabled, but the face changed to reflect SPECS. This function will make the variable `buffer-face-mode-face' buffer local, and set it to SPECS." @@ -384,14 +443,16 @@ buffer local, and set it to SPECS." (buffer-face-mode t))) (defun buffer-face-mode-invoke (specs arg &optional interactive) - "Enable or disable `buffer-face-mode' using face specs SPECS, and argument ARG. + "Enable or disable `buffer-face-mode' using face specs SPECS. ARG controls whether the mode is enabled or disabled, and is interpreted in the usual manner for minor-mode commands. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute +SPECS can be any value suitable for a `face' text property, +including a face name, a plist of face attributes and values, +or a list of faces. -If INTERACTIVE is non-nil, a message will be displayed describing the result. +If INTERACTIVE is non-nil, display a message describing the +result. This is a wrapper function which calls `buffer-face-set' or `buffer-face-toggle' (depending on ARG), and prints a status