Add lisp/face-remap.el and associated documentation

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1200

7 files changed, 366 insertions, 0 deletions

diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 1520c26f1e8..314c42d4dff 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,7 @@
+2008-06-03  Miles Bader  <miles@gnu.org>
+
+        * display.texi (Temporary Face Changes): New node.
+
 2008-05-31  Eli Zaretskii  <eliz@gnu.org>
 
         * msdog.texi (Windows Keyboard): Fix text added on 2008-05-29.
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index b48d6bbab7d..9cf8c986d4a 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -31,6 +31,7 @@ their values only make a difference at the time of redisplay.
 * 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 @@ truncate a line which is exactly as wide as the window.  Instead, the
 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 --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 943504fce04..92d49d94a62 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,9 @@
+2008-06-03  Miles Bader  <miles@gnu.org>
+
+        * 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  <miles@gnu.org>
 
         * display.texi (Displaying Faces): Add face-remapping-alist.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index bc57cfea26d..ef8f5bc4e5c 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2420,6 +2420,78 @@ with the height doubled:
 
 @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 --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0f9730d19b9..33a7651ad93 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2008-06-03  Miles Bader  <miles@gnu.org>
+
+        * face-remap.el: New file.
+        * Makefile.in (ELCFILES): Add face-remap.elc.
+
 2008-06-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * progmodes/flymake.el (flymake-process-filter): Make sure the source
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index b92024e7242..2fa71c9a52e 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -480,6 +480,7 @@ ELCFILES = \
         $(lisp)/eshell/eshell.elc \
         $(lisp)/expand.elc \
         $(lisp)/ezimage.elc \
+        $(lisp)/face-remap.elc \
         $(lisp)/facemenu.elc \
         $(lisp)/faces.elc \
         $(lisp)/ffap.elc \
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
new file mode 100644
index 00000000000..fe517a77a33
--- /dev/null
+++ b/lisp/face-remap.el
@@ -0,0 +1,242 @@
+;;; face-remap.el --- Functions for managing `face-remapping-alist'
+;;
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+;;
+;; Author: Miles Bader <miles@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+;;
+
+;;; 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