]> code.delx.au - gnu-emacs/blobdiff - lisp/face-remap.el
Fixes: debbugs:6594
[gnu-emacs] / lisp / face-remap.el
index ddc9f22ddfa110f21a837da28095f863481f448c..6bb84acb16c9b802d6d6359bd296d4095d94255a 100644 (file)
@@ -1,9 +1,9 @@
 ;;; face-remap.el --- Functions for managing `face-remapping-alist'
 ;;
-;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010, 2011 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.
 ;;
@@ -103,7 +103,7 @@ The list structure of ENTRY may be destructively modified."
   (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.
 
@@ -121,6 +121,8 @@ 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'."
+  (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)
@@ -144,7 +146,7 @@ COOKIE should be the return value from that function."
                  (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."
   (let ((entry (assq face face-remapping-alist)))
@@ -158,13 +160,15 @@ COOKIE should be the return value from that function."
                (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."
+  (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
@@ -184,7 +188,8 @@ not inherit from the global definition of FACE."
   "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)
@@ -206,10 +211,10 @@ The amount of scaling is determined by the variable
 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))
@@ -225,7 +230,20 @@ be used to interactively modify the variable
   (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.
 
@@ -239,7 +257,7 @@ will remove any scaling currently active."
   (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")
@@ -250,7 +268,7 @@ See `text-scale-increase' for more details."
 ;;;###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
@@ -277,7 +295,8 @@ a top-level keymap, `text-scale-increase' or
   (interactive "p")
   (let ((first t)
        (step t)
-       (ev last-command-event))
+       (ev last-command-event)
+       (echo-keystrokes nil))
     (while step
       (let ((base (event-basic-type ev)))
        (cond ((or (eq base ?+) (eq base ?=))
@@ -293,7 +312,7 @@ a top-level keymap, `text-scale-increase' or
       (when step
        (text-scale-increase step)
        (setq inc 1 first nil)
-       (setq ev (read-event))))
+       (setq ev (read-event "+,-,0 for further adjustment: "))))
     (push ev unread-command-events)))
 
 \f
@@ -305,7 +324,8 @@ a top-level keymap, `text-scale-increase' or
 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)
@@ -325,43 +345,62 @@ When enabled, the face specified by the variable
   (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.
+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")))
-  (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.
+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 `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 the `face' text property,
+including a face name, a list of face names, or a face-attribute
+
+If INTERACTIVE is non-nil, a message will be displayed 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))))
@@ -378,7 +417,8 @@ If INTERACTIVE is non-nil, a message will be displayed describing the result."
 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)