* lisp/loadup.el: Count byte-code functions as well.

[gnu-emacs] / lisp / face-remap.el

diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 32bba13d00d60ef618fca4d9316d7b79486ffe7b..be2207a993f04c42ac7e05b5cdaa6d4f02a3c3c2 100644 (file)
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -1,9 +1,9 @@
 ;;; face-remap.el --- Functions for managing `face-remapping-alist'
 ;;
 ;;; 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>
 ;;
 ;; Author: Miles Bader <miles@gnu.org>

-;; Keywords: faces face remapping display user commands
+;; Keywords: faces, face remapping, display, user commands

 ;;
 ;; This file is part of GNU Emacs.
 ;;
 ;;
 ;; This file is part of GNU Emacs.
 ;;


@@ -106,21 +106,25 @@ The list structure of ENTRY may be destructively modified."
 ;;;###autoload
 (defun face-remap-add-relative (face &rest specs)
   "Add a face remapping entry of FACE to SPECS in the current buffer.
 ;;;###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'.
 
 `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)
   (while (and (consp specs) (null (cdr specs)))
     (setq specs (car specs)))
   (make-local-variable 'face-remapping-alist)


@@ -148,7 +152,9 @@ COOKIE should be the return value from that function."
 
 ;;;###autoload
 (defun face-remap-reset-base (face)
 
 ;;;###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
   (let ((entry (assq face face-remapping-alist)))
     (when entry
       ;; If there's nothing except a base remapping, we simply remove


@@ -163,10 +169,17 @@ COOKIE should be the return value from that function."
 ;;;###autoload
 (defun face-remap-set-base (face &rest specs)
   "Set the base remapping of FACE in the current buffer to SPECS.
 ;;;###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)
   (while (and (consp specs) (not (null (car specs))) (null (cdr specs)))
     (setq specs (car specs)))
   (if (or (null specs)


@@ -188,7 +201,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
   "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)
 
 ;; current remapping cookie for text-scale-mode
 (defvar text-scale-mode-remapping nil)


@@ -203,17 +217,20 @@ Each positive or negative step scales the default face height by this amount."
 (make-variable-buffer-local 'text-scale-mode-amount)
 
 (define-minor-mode text-scale-mode
 (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 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))
   :lighter (" " text-scale-mode-lighter)
   (when text-scale-mode-remapping
     (face-remap-remove-relative text-scale-mode-remapping))


@@ -229,7 +246,20 @@ be used to interactively modify the variable
   (force-window-update (current-buffer)))
 
 ;;;###autoload
   (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.
 
   "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.
 


@@ -243,7 +273,7 @@ will remove any scaling currently active."
   (text-scale-mode (if (zerop text-scale-mode-amount) -1 1)))
 
 ;;;###autoload
   (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")
   "Decrease the height of the default face in the current buffer by DEC steps.
 See `text-scale-increase' for more details."
   (interactive "p")


@@ -254,7 +284,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
 ;;;###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
   "Increase or decrease the height of the default face in the current buffer.
 
 The actual adjustment made depends on the final component of the


@@ -280,26 +310,29 @@ a top-level keymap, `text-scale-increase' or
 `text-scale-decrease' may be more appropriate."
   (interactive "p")
   (let ((first t)
 `text-scale-decrease' may be more appropriate."
   (interactive "p")
   (let ((first t)

-       (step t)

        (ev last-command-event)
        (echo-keystrokes nil))
        (ev last-command-event)
        (echo-keystrokes nil))

-    (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)))
+    (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
 ;; ----------------------------------------------------------------
 
 \f
 ;; ----------------------------------------------------------------


@@ -310,7 +343,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."
 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)
 
 ;; current remapping cookie for  buffer-face-mode
 (defvar buffer-face-mode-remapping nil)


@@ -319,8 +353,10 @@ plist, etc."
 ;;;###autoload
 (define-minor-mode buffer-face-mode
   "Minor mode for a buffer-specific default face.
 ;;;###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))
   :lighter " BufFace"
   (when buffer-face-mode-remapping
     (face-remap-remove-relative buffer-face-mode-remapping))


@@ -332,12 +368,14 @@ When enabled, the face specified by the variable
 ;;;###autoload
 (defun buffer-face-set (&rest specs)
   "Enable `buffer-face-mode', using face specs SPECS.
 ;;;###autoload
 (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."
+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")))
   (while (and (consp specs) (null (cdr specs)))
     (setq specs (car specs)))
   (interactive (list (read-face-name "Set buffer face")))
   (while (and (consp specs) (null (cdr specs)))
     (setq specs (car specs)))


@@ -349,8 +387,10 @@ buffer local, and set it to FACE."
 ;;;###autoload
 (defun buffer-face-toggle (&rest specs)
   "Toggle `buffer-face-mode', using face specs SPECS.
 ;;;###autoload
 (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
+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 specs SPECS, then it is disabled; if buffer-face-mode is
 
 If `buffer-face-mode' is already enabled, and is currently using
 the face specs SPECS, then it is disabled; if buffer-face-mode is


@@ -373,10 +413,12 @@ buffer local, and set it to SPECS."
 ARG controls whether the mode is enabled or disabled, and is
 interpreted in the usual manner for minor-mode commands.
 
 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
+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, a message will be displayed describing the result.
+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
 
 This is a wrapper function which calls `buffer-face-set' or
 `buffer-face-toggle' (depending on ARG), and prints a status


@@ -402,10 +444,10 @@ may be more appropriate."
 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)))
 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)
 
 
 
 (provide 'face-remap)
 

-;; arch-tag: 5c5f034b-8d58-4967-82bd-d61fd364e686

 ;;; face-remap.el ends here
 ;;; face-remap.el ends here