;;; face-remap.el --- Functions for managing `face-remapping-alist' -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2008-2013 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
(let ((faces (cdr entry)))
(if (symbolp faces)
(setq faces (list faces)))
- (setcdr entry (face-remap-order (cons specs 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)
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
((or ?+ ?=) inc)
(?- (- inc))
(?0 0)
- (t inc))))
+ (_ inc))))
(text-scale-increase step)
;; (unless (zerop step)
(message "Use +,-,0 for further adjustment")
- (set-temporary-overlay-map
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (mods '(() (control)))
(dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +.
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")