;;; face-remap.el --- Functions for managing `face-remapping-alist'
;;
-;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
-;; Keywords: faces face display user commands
+;; Keywords: faces, face remapping, display, user commands
;;
;; This file is part of GNU Emacs.
;;
(setcdr entry (sort (cdr entry) 'face-attrs-more-relative-p))
(nreverse entry))
-;;;### autoload
+;;;###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)
(let ((entry (assq face face-remapping-alist)))
(when (null entry)
(remq remapping face-remapping-alist)))
(cdr cookie))))))
-;;;### autoload
+;;;###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
(remq entry face-remapping-alist))
(setcar (last entry) face))))) ; otherwise, just inherit global def
-;;;### autoload
+;;;###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)
(and (eq (car specs) face) (null (cdr specs)))) ; default
;; Set entry back to default
"Scale factor used by `text-scale-mode'.
Each positive or negative step scales the default face height by this amount."
:group 'display
- :type 'number)
+ :type 'number
+ :version "23.1")
;; current remapping cookie for text-scale-mode
(defvar text-scale-mode-remapping nil)
(make-variable-buffer-local 'text-scale-mode-amount)
(define-minor-mode text-scale-mode
- "Minor mode for displaying buffer text in a larger/smaller font than usual.
+ "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
face size by the value of the variable `text-scale-mode-step'
\(a negative amount shrinks the text).
-The `text-scale-increase' and `text-scale-decrease' functions may
-be used to interactively modify the variable
-`text-scale-mode-amount' (they also enable or disable
-`text-scale-mode' as necessary)."
+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)."
:lighter (" " text-scale-mode-lighter)
(when text-scale-mode-remapping
(face-remap-remove-relative text-scale-mode-remapping))
(force-window-update (current-buffer)))
;;;###autoload
-(defun text-scale-increase (&optional inc)
+(defun text-scale-set (level)
+ "Set the scale factor of the default face in the current buffer to LEVEL.
+If LEVEL is non-zero, `text-scale-mode' is enabled, otherwise it is disabled.
+
+LEVEL is a number of steps, with 0 representing the default size.
+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)
+ (text-scale-mode (if (zerop text-scale-mode-amount) -1 1)))
+
+;;;###autoload
+(defun text-scale-increase (inc)
"Increase the height of the default face in the current buffer by INC steps.
If the new height is other than the default, `text-scale-mode' is enabled.
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 (+ text-scale-mode-amount inc)))
+ (setq text-scale-mode-amount
+ (if (= inc 0) 0 (+ (if text-scale-mode text-scale-mode-amount 0) inc)))
(text-scale-mode (if (zerop text-scale-mode-amount) -1 1)))
;;;###autoload
-(defun text-scale-decrease (&optional dec)
+(defun text-scale-decrease (dec)
"Decrease the height of the default face in the current buffer by DEC steps.
See `text-scale-increase' for more details."
(interactive "p")
;;;###autoload (define-key ctl-x-map [(control ?=)] 'text-scale-adjust)
;;;###autoload (define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
;;;###autoload
-(defun text-scale-adjust (&optional inc)
+(defun text-scale-adjust (inc)
"Increase or decrease the height of the default face in the current buffer.
The actual adjustment made depends on the final component of the
`text-scale-decrease' may be more appropriate."
(interactive "p")
(let ((first t)
- (step t)
- (ev last-command-event))
- (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))))
- (push ev unread-command-events)))
+ (ev last-command-event)
+ (echo-keystrokes nil))
+ (let* ((base (event-basic-type ev))
+ (step
+ (pcase base
+ ((or `?+ `?=) inc)
+ (`?- (- inc))
+ (`?0 0)
+ (t inc))))
+ (text-scale-increase step)
+ ;; FIXME: do it after everu "iteration of the loop".
+ (message "+,-,0 for further adjustment: ")
+ (set-temporary-overlay-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))))
\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."
- :group 'display)
+ :group 'display
+ :version "23.1")
;; current remapping cookie for buffer-face-mode
(defvar buffer-face-mode-remapping nil)
;;;###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))
(force-window-update (current-buffer)))
;;;###autoload
-(defun buffer-face-set (face)
- "Enable `buffer-face-mode', using the face FACE.
-If FACE 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."
+(defun buffer-face-set (&rest specs)
+ "Enable `buffer-face-mode', using face specs SPECS.
+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")))
- (if (null face)
+ (while (and (consp specs) (null (cdr specs)))
+ (setq specs (car specs)))
+ (if (null specs)
(buffer-face-mode 0)
- (set (make-local-variable 'buffer-face-mode-face) face)
+ (set (make-local-variable 'buffer-face-mode-face) specs)
(buffer-face-mode t)))
;;;###autoload
-(defun buffer-face-toggle (face)
- "Toggle `buffer-face-mode', using the face FACE.
+(defun buffer-face-toggle (&rest specs)
+ "Toggle `buffer-face-mode', using face specs SPECS.
+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 FACE, then it is disabled; if buffer-face-mode is
+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 FACE. This
-function will make the variable `buffer-face-mode-face' buffer
-local, and set it to 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."
(interactive (list buffer-face-mode-face))
- (if (or (null face)
- (and buffer-face-mode (equal buffer-face-mode-face face)))
+ (while (and (consp specs) (null (cdr specs)))
+ (setq specs (car specs)))
+ (if (or (null specs)
+ (and buffer-face-mode (equal buffer-face-mode-face specs)))
(buffer-face-mode 0)
- (set (make-local-variable 'buffer-face-mode-face) face)
+ (set (make-local-variable 'buffer-face-mode-face) specs)
(buffer-face-mode t)))
-(defun buffer-face-mode-invoke (face arg &optional interactive)
- "Enable or disable `buffer-face-mode' using the face FACE, and argument ARG.
-ARG is interpreted in the usual manner for minor-mode commands.
-Besides the choice of face, this is the same as the `buffer-face-mode' command.
-If INTERACTIVE is non-nil, a message will be displayed describing the result."
+(defun buffer-face-mode-invoke (specs arg &optional interactive)
+ "Enable or disable `buffer-face-mode' using face specs SPECS, and argument ARG.
+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 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, 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
+message in the echo area. In many cases one of those functions
+may be more appropriate."
(let ((last-message (current-message)))
(if (or (eq arg 'toggle) (not arg))
- (buffer-face-toggle face)
- (buffer-face-set (and (> (prefix-numeric-value arg) 0) face)))
+ (buffer-face-toggle specs)
+ (buffer-face-set (and (> (prefix-numeric-value arg) 0) specs)))
(when interactive
(unless (and (current-message)
(not (equal last-message (current-message))))
An interface to `buffer-face-mode' which uses the `variable-pitch' face.
Besides the choice of face, it is the same as `buffer-face-mode'."
(interactive (list (or current-prefix-arg 'toggle)))
- (buffer-face-mode-invoke 'variable-pitch arg (interactive-p)))
+ (buffer-face-mode-invoke 'variable-pitch arg
+ (called-interactively-p 'interactive)))
(provide 'face-remap)
-;; arch-tag: 5c5f034b-8d58-4967-82bd-d61fd364e686
;;; face-remap.el ends here