# HG changeset patch # User Miles Bader # Date 1212491152 0 # Node ID 328f63bafded4f01667489cca714c53098d3ab9d # Parent ad40a2d6712f9e2577edf21e8e2fd3c856de545c Add lisp/face-remap.el and associated documentation Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1200 diff -r ad40a2d6712f -r 328f63bafded doc/emacs/ChangeLog --- a/doc/emacs/ChangeLog Tue Jun 03 10:47:29 2008 +0000 +++ b/doc/emacs/ChangeLog Tue Jun 03 11:05:52 2008 +0000 @@ -1,3 +1,7 @@ +2008-06-03 Miles Bader + + * display.texi (Temporary Face Changes): New node. + 2008-05-31 Eli Zaretskii * msdog.texi (Windows Keyboard): Fix text added on 2008-05-29. diff -r ad40a2d6712f -r 328f63bafded doc/emacs/display.texi --- a/doc/emacs/display.texi Tue Jun 03 10:47:29 2008 +0000 +++ b/doc/emacs/display.texi Tue Jun 03 11:05:52 2008 +0000 @@ -31,6 +31,7 @@ * Cursor Display:: Features for displaying the cursor. * Line Truncation:: Truncating lines to fit the screen width instead of continuing them to multiple screen lines. +* Temporary Face Changes:: Commands to temporarily modify the default text face * Display Custom:: Information on variables for customizing display. @end menu @@ -1171,6 +1172,41 @@ newline overflows into the right fringe, and the cursor appears in the fringe when positioned on that newline. +@node Temporary Face Changes +@section Temporary Face Changes + +These are commands which temporarily change the default face used to +display text in a buffer. + +@cindex increase buffer face height +@findex increase-buffer-face-height +@cindex decrease buffer face height +@findex decrease-buffer-face-height +@findex text-scale-mode +To increase the size of the font used to display text in the current +buffer, type @kbd{C-=} or @kbd{C-+} +(@code{increase-buffer-face-height}). With a numeric prefix argument, +the size will be increased by that many steps (the default is 1 step); +each step scales the font height by the value of the variable +@code{text-scale-mode-step}. If repeated, this command has a +cumulative effect. As a special case, a prefix argument of 0 will +remove any scaling currently active. + +To decrease the size of the text, type @kbd{C--} +(@code{decrease-buffer-face-height}). The behavior is similar to that +of @code{increase-buffer-face-height}, but in reverse. + +These commands automatically enable or disable the +@code{text-scale-mode} minor-mode, depending on whether the current +font scaling is other than 1 or not. + +@cindex variable pitch mode +@findex variable-pitch-mode +To temporarily change the display face in the current buffer to a +variable-pitch (``proportional'') font, use the command @kbd{M-x +variable-pitch-mode} to enable or disable the Variable Pitch minor +mode. + @node Display Custom @section Customization of Display diff -r ad40a2d6712f -r 328f63bafded doc/lispref/ChangeLog --- a/doc/lispref/ChangeLog Tue Jun 03 10:47:29 2008 +0000 +++ b/doc/lispref/ChangeLog Tue Jun 03 11:05:52 2008 +0000 @@ -1,3 +1,9 @@ +2008-06-03 Miles Bader + + * display.texi (Displaying Faces): Add + add-relative-face-remapping, remove-relative-face-remapping, + set-base-face-remapping, and set-default-base-face-remapping. + 2008-06-01 Miles Bader * display.texi (Displaying Faces): Add face-remapping-alist. diff -r ad40a2d6712f -r 328f63bafded doc/lispref/display.texi --- a/doc/lispref/display.texi Tue Jun 03 10:47:29 2008 +0000 +++ b/doc/lispref/display.texi Tue Jun 03 11:05:52 2008 +0000 @@ -2420,6 +2420,78 @@ @end defvar +@noindent +The following functions implement a somewhat higher-level interface to +@code{face-remapping-alist}, making it easier to use +``cooperatively''. They are mainly intended for buffer-local use, and +so all make @code{face-remapping-alist} variable buffer-local as a +side-effect. + +These functions use entries in @code{face-remapping-alist} which have +the general form: + +@example + (@var{face} @var{relative_specs_1} @var{relative_specs_2} @var{...} @var{base_specs}) +@end example + +Everything except the @var{face} is a ``face spec'', a list of face +names or face attribute-value pairs. All face specs are merged +together, with earlier values taking precedence. + +The @var{relative_specs_}n values are ``relative specs'', and are +added by @code{add-relative-face-remapping} (and removed by +@code{remove-relative-face-remapping}. These are intended for face +modifications (such as increasing the size). Typical users of these +relative specs would be minor modes. + +@var{base_specs} is the lowest-priority value, and by default is just the +face name, which causes the global definition of that face to be used. + +A non-default value of @var{base_specs} may also be set using +@code{set-base-face-remapping}. Because this @emph{overwrites} the +default base-spec value (which inherits the global face definition), +it is up to the caller of @code{set-base-face-remapping} to add such +inheritance if it is desired. A typical use of +@code{set-base-face-remapping} would be a major mode adding a face +remappings, e.g., of the default face. + + +@defun add-relative-face-remapping face &rest specs +This functions adds a face remapping entry of @var{face} to @var{specs} +in the current buffer. + +It returns a ``cookie'' which can be used to later delete the remapping with +@code{remove-relative-face-remapping}. + +@var{specs} can be any value suitable for the @code{face} text +property, including a face name, a list of face names, or a +face-attribute property list. The attributes given by @var{specs} +will be merged with any other currently active face remappings of +@var{face}, and with the global definition of @var{face} (by default; +this may be changed using @code{set-base-face-remapping}), +with the most recently added relative remapping taking precedence. +@end defun + +@defun remove-relative-face-remapping cookie +This function removes a face remapping previously added by +@code{add-relative-face-remapping}. @var{cookie} should be a return +value from that function. +@end defun + +@defun set-base-face-remapping face &rest specs +This function sets the ``base remapping'' of @var{face} in the current +buffer to @var{specs}. If @var{specs} is empty, the default base +remapping is restored, which inherits from the global definition of +@var{face}; note that this is different from @var{specs} containing a +single value @code{nil}, which has the opposite result (the global +definition of @var{face} is ignored). +@end defun + +@defun set-default-base-face-remapping face +This function sets the ``base remapping'' of @var{face} to its default +value, which inherits from @var{face}'s global definition. +@end defun + @node Font Selection @subsection Font Selection diff -r ad40a2d6712f -r 328f63bafded lisp/ChangeLog --- a/lisp/ChangeLog Tue Jun 03 10:47:29 2008 +0000 +++ b/lisp/ChangeLog Tue Jun 03 11:05:52 2008 +0000 @@ -1,3 +1,8 @@ +2008-06-03 Miles Bader + + * face-remap.el: New file. + * Makefile.in (ELCFILES): Add face-remap.elc. + 2008-06-03 Stefan Monnier * progmodes/flymake.el (flymake-process-filter): Make sure the source diff -r ad40a2d6712f -r 328f63bafded lisp/Makefile.in --- a/lisp/Makefile.in Tue Jun 03 10:47:29 2008 +0000 +++ b/lisp/Makefile.in Tue Jun 03 11:05:52 2008 +0000 @@ -480,6 +480,7 @@ $(lisp)/eshell/eshell.elc \ $(lisp)/expand.elc \ $(lisp)/ezimage.elc \ + $(lisp)/face-remap.elc \ $(lisp)/facemenu.elc \ $(lisp)/faces.elc \ $(lisp)/ffap.elc \ diff -r ad40a2d6712f -r 328f63bafded lisp/face-remap.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/face-remap.el Tue Jun 03 11:05:52 2008 +0000 @@ -0,0 +1,242 @@ +;;; face-remap.el --- Functions for managing `face-remapping-alist' +;; +;; Copyright (C) 2008 Free Software Foundation, Inc. +;; +;; Author: Miles Bader +;; Keywords: faces face display user commands +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;; + +;;; Commentary: + +;; +;; This file defines some simple operations that can be used for +;; maintaining the `face-remapping-alist' in a cooperative way. This is +;; especially important for the `default' face. +;; +;; Each face-remapping definition in `face-remapping-alist' added by +;; this code uses the form: +;; +;; (face RELATIVE_SPECS_1 RELATIVE_SPECS_2 ... BASE_SPECS) +;; +;; The "specs" values are a lists of face names or face attribute-value +;; pairs, and are merged together, with earlier values taking precedence. +;; +;; The RELATIVE_SPECS_* values are added by `add-relative-face-remapping' +;; (and removed by `remove-relative-face-remapping', and are intended for +;; face "modifications" (such as increasing the size). Typical users of +;; relative specs would be minor modes. +;; +;; BASE_SPECS is the lowest-priority value, and by default is just the +;; face name, which causes the global definition of that face to be used. +;; +;; A non-default value of BASE_SPECS may also be set using +;; `set-base-face-remapping'. Because this _overwrites_ the default +;; value inheriting from the global face definition, it is up to the +;; caller of set-base-face-remapping to add such inheritance if it is +;; desired. A typical use of set-base-face-remapping would be a major +;; mode setting face remappings, e.g., of the default face. +;; +;; All modifications cause face-remapping-alist to be made buffer-local. +;; + + +;;; Code: + + +;; ---------------------------------------------------------------- +;; Utility functions + +;;;### autoload +(defun add-relative-face-remapping (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 +`remove-relative-face-remapping'. + +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, with the most recently added relative +remapping taking precedence. + +The base (lowest priority) remapping may be set to a specific +value, instead of the default of the global face definition, +using `set-base-face-remapping'." + (make-local-variable 'face-remapping-alist) + (let ((entry (assq face face-remapping-alist))) + (when (null entry) + (setq entry (list face face)) ; explicitly merge with global def + (push entry face-remapping-alist)) + (setcdr entry (cons specs (cdr entry))) + (cons face specs))) + +(defun remove-relative-face-remapping (cookie) + "Remove a face remapping previously added by `add-relative-face-remapping'. +COOKIE should be the return value from that function." + (let ((remapping (assq (car cookie) face-remapping-alist))) + (when remapping + (let ((updated-entries (remq (cdr cookie) (cdr remapping)))) + (unless (eq updated-entries (cdr remapping)) + (setcdr remapping updated-entries) + (when (or (null updated-entries) + (and (eq (car-safe updated-entries) (car cookie)) + (null (cdr updated-entries)))) + (setq face-remapping-alist + (remq remapping face-remapping-alist))) + (cdr cookie)))))) + +;;;### autoload +(defun set-default-base-face-remapping (face) + "Set the base remapping of FACE to inherit from FACE's global definition." + (let ((entry (assq face face-remapping-alist))) + (when entry + ;; If there's nothing except a base remapping, we simply remove + ;; the entire remapping entry, as setting the base to the default + ;; would be the same as the global definition. Otherwise, we + ;; modify the base remapping. + (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 + +;;;### autoload +(defun set-base-face-remapping (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." + (if (or (null specs) + (and (eq (car specs) face) (null (cdr specs)))) ; default + ;; Set entry back to default + (set-default-base-face-remapping face) + ;; Set the base remapping + (make-local-variable 'face-remapping-alist) + (let ((entry (assq face face-remapping-alist))) + (if entry + (setcar (last entry) specs) ; overwrite existing base entry + (push (list face specs) face-remapping-alist))))) + + +;; ---------------------------------------------------------------- +;; text-scale-mode + +(defcustom text-scale-mode-step 1.2 + "Scale factor used by `text-scale-mode'. +Each positive or negative step scales the default face height by this amount." + :group 'display + :type 'number) + +;; current remapping cookie for text-scale-mode +(defvar text-scale-mode-remapping nil) +(make-variable-buffer-local 'text-scale-mode-remapping) + +;; Lighter displayed for text-scale-mode in mode-line minor-mode list +(defvar text-scale-mode-lighter "+0") +(make-variable-buffer-local 'text-scale-mode-lighter) + +;; Number of steps that text-scale-mode will increase/decrease text height +(defvar text-scale-mode-amount 0) +(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. + +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 `increase-buffer-face-height' and +`decrease-buffer-face-height' 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 + (remove-relative-face-remapping text-scale-mode-remapping)) + (setq text-scale-mode-lighter + (format (if (>= text-scale-mode-amount 0) "+%d" "%d") + text-scale-mode-amount)) + (setq text-scale-mode-remapping + (and text-scale-mode + (add-relative-face-remapping 'default + :height + (expt text-scale-mode-step + text-scale-mode-amount)))) + (force-window-update (current-buffer))) + +;;;###autoload (global-set-key [(control =)] 'increase-buffer-face-height) +;;;###autoload (global-set-key [(control +)] 'increase-buffer-face-height) +;;;###autoload +(defun increase-buffer-face-height (&optional 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. + +Each step scales the height of the default face by the variable +`text-scale-mode-step' (a negative number of steps decreases the +height by the same amount). As a special case, an argument of 0 +will remove any scaling currently active." + (interactive + (list + (cond ((eq current-prefix-arg '-) -1) + ((numberp current-prefix-arg) current-prefix-arg) + ((consp current-prefix-arg) -1) + (t 1)))) + (setq text-scale-mode-amount (if (= inc 0) 0 (+ text-scale-mode-amount inc))) + (text-scale-mode (if (zerop text-scale-mode-amount) -1 1))) + +;;;###autoload (global-set-key [(control -)] 'decrease-buffer-face-height) +;;;###autoload +(defun decrease-buffer-face-height (&optional dec) + "Decrease the height of the default face in the current buffer by DEC steps. +See `increase-buffer-face-height' for more details." + (interactive + (list + (cond ((eq current-prefix-arg '-) -1) + ((numberp current-prefix-arg) current-prefix-arg) + ((consp current-prefix-arg) -1) + (t 1)))) + (increase-buffer-face-height (- dec))) + + +;; ---------------------------------------------------------------- +;; variable-pitch-mode + +;; suggested key binding: (global-set-key "\C-cv" 'variable-pitch-mode) + +;; current remapping cookie for variable-pitch-mode +(defvar variable-pitch-mode-remapping nil) +(make-variable-buffer-local 'variable-pitch-mode-remapping) + +(define-minor-mode variable-pitch-mode + "Variable-pitch default-face mode. When active, causes the +buffer text to be displayed using the `variable-pitch' face." + :lighter " VarPitch" + (when variable-pitch-mode-remapping + (remove-relative-face-remapping variable-pitch-mode-remapping)) + (setq variable-pitch-mode-remapping + (and variable-pitch-mode + (add-relative-face-remapping 'default 'variable-pitch))) + (force-window-update (current-buffer))) + + +(provide 'face-remap) + +;; arch-tag: 5c5f034b-8d58-4967-82bd-d61fd364e686 +;;; face-remap.el ends here