-;;; 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 <miles@gnu.org>
;; Keywords: faces, face remapping, display, user commands
: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.
Return a cookie which can be used to delete this remapping with
`face-remap-remove-relative'.
-The remaining arguments, SPECS, should be either a list of face
-names, or a property list of face attribute/value pairs. The
-remapping specified by SPECS takes effect alongside the
-remappings from other calls to `face-remap-add-relative', 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 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'."
(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)
(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
(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.
This causes the remappings specified by `face-remap-add-relative'
-to apply on top of the face specification given by SPECS. SPECS
-should be either a list of face names, or a property list of face
-attribute/value pairs.
+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
+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)))
(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)))
\f
;; ----------------------------------------------------------------
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.
`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
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
;;;###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:
- 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
a top-level keymap, `text-scale-increase' or
`text-scale-decrease' may be more appropriate."
(interactive "p")
- (let ((first t)
- (ev last-command-event)
+ (let ((ev last-command-event)
(echo-keystrokes nil))
(let* ((base (event-basic-type ev))
(step
(pcase base
- ((or `?+ `?=) inc)
- (`?- (- inc))
- (`?0 0)
- (t inc))))
+ ((or ?+ ?=) inc)
+ (?- (- inc))
+ (?0 0)
+ (_ inc))))
(text-scale-increase step)
- ;; FIXME: do it after everu "iteration of the loop".
- (message "+,-,0 for further adjustment: ")
- (set-temporary-overlay-map
+ ;; (unless (zerop step)
+ (message "Use +,-,0 for further adjustment")
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (mods '(() (control)))
- (define-key map (vector (append mods '(?-))) 'text-scale-decrease)
- (define-key map (vector (append mods '(?+))) 'text-scale-increase)
- ;; = is unshifted + on most keyboards.
- (define-key map (vector (append mods '(?=))) 'text-scale-increase)
- (define-key map (vector (append mods '(?0)))
- (lambda () (interactive) (text-scale-increase 0))))
- map)
- t))))
+ (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +.
+ (define-key map (vector (append mods (list key)))
+ (lambda () (interactive) (text-scale-adjust (abs inc))))))
+ map))))) ;; )
\f
;; ----------------------------------------------------------------
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")
;;;###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)
;;;###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."
(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