;;; facemenu.el --- create a face menu for interactively adding fonts to text
-;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
;;
;; The order of the faces that appear in the menu and their keybindings can be
;; controlled by setting the variables `facemenu-keybindings' and
-;; `facemenu-new-faces-at-end'. List faces that you don't use in documents
-;; (eg, `region') in `facemenu-unlisted-faces'.
+;; `facemenu-new-faces-at-end'. List faces that you want to use in documents
+;; in `facemenu-listed-faces'.
;;; Known Problems:
;; Bold and Italic do not combine to create bold-italic if you select them
the binding is made in `facemenu-keymap'.
The faces specifically mentioned in this list are put at the top of
-the menu, in the order specified. All other faces which are defined,
-except for those in `facemenu-unlisted-faces', are listed after them,
-but get no keyboard equivalents.
+the menu, in the order specified. All other faces which are defined
+in `facemenu-listed-faces' are listed after them, but get no
+keyboard equivalents.
If you change this variable after loading facemenu.el, you will need to call
`facemenu-update' to make it take effect."
:type 'boolean
:group 'facemenu)
-(defcustom facemenu-unlisted-faces
- `(modeline region secondary-selection highlight scratch-face
- ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
- ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
- ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-"))
- "*List of faces not to include in the Face menu.
-Each element may be either a symbol, which is the name of a face, or a string,
-which is a regular expression to be matched against face names. Matching
-faces will not be added to the menu.
-
-You can set this list before loading facemenu.el, or add a face to it before
-creating that face if you do not want it to be listed. If you change the
-variable so as to eliminate faces that have already been added to the menu,
-call `facemenu-update' to recalculate the menu contents.
-
-If this variable is t, no faces will be added to the menu. This is useful for
-temporarily turning off the feature that automatically adds faces to the menu
-when they are created."
- :type '(choice (const :tag "Don't add faces" t)
- (const :tag "None (do add any face)" nil)
- (repeat (choice symbol regexp)))
- :group 'facemenu)
+(defcustom facemenu-listed-faces nil
+ "*List of faces to include in the Face menu.
+Each element should be a symbol, the name of a face.
+The \"basic \" faces in `facemenu-keybindings' are automatically
+added to the Face menu, and need not be in this list.
+
+This value takes effect when you load facemenu.el. If the
+list includes symbols which are not defined as faces, they
+are ignored; however, subsequently defining or creating
+those faces adds them to the menu then. You can call
+`facemenu-update' to recalculate the menu contents, such as
+if you change the value of this variable,
+
+If this variable is t, all faces that you apply to text
+using the face menu commands (even by name), and all faces
+that you define or create, are added to the menu. You may
+find it useful to set this variable to t temporarily while
+you define some faces, so that they will be added. However,
+if the value is no longer t and you call `facemenu-update',
+it will remove any faces not explicitly in the list."
+ :type '(choice (const :tag "List all faces" t)
+ (const :tag "None" nil)
+ (repeat symbol))
+ :group 'facemenu
+ :version "22.1")
;;;###autoload
(defvar facemenu-face-menu
;;; Internal Variables
(defvar facemenu-color-alist nil
- ;; Don't initialize here; that doesn't work if preloaded.
"Alist of colors, used for completion.
-If null, `facemenu-read-color' will set it.")
+If this is nil, then the value of (defined-colors) is used.")
(defun facemenu-update ()
"Add or update the \"Face\" menu in the menu bar.
;;;###autoload
(defun facemenu-set-face (face &optional start end)
- "Add FACE to the region or next character typed.
-This adds FACE to the top of the face list; any faces lower on the list that
-will not show through at all will be removed.
-
-Interactively, reads the face name with the minibuffer.
-
-If the region is active (normally true except in Transient Mark mode)
-and there is no prefix argument, this command sets the region to the
-requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted. Moving point or switching buffers before
-typing a character to insert cancels the specification."
+ "Apply FACE to the region or next character typed.
+
+If the region is active (normally true except in Transient
+Mark mode) and nonempty, and there is no prefix argument,
+this command applies FACE to the region. Otherwise, it applies FACE
+to the faces to use for the next character
+inserted. (Moving point or switching buffers before typing
+a character to insert cancels the specification.)
+
+If FACE is `default', to \"apply\" it means clearing
+the list of faces to be used. For any other value of FACE,
+to \"apply\" it means putting FACE at the front of the list
+of faces to be used, and removing any faces further
+along in the list that would be completely overridden by
+preceding faces (including FACE).
+
+This command can also add FACE to the menu of faces,
+if `facemenu-listed-faces' says to do that."
(interactive (list (progn
(barf-if-buffer-read-only)
(read-face-name "Use face"))
;;;###autoload
(defun facemenu-read-color (&optional prompt)
"Read a color using the minibuffer."
- (let ((col (completing-read (or prompt "Color: ")
- (or facemenu-color-alist
- (defined-colors))
- nil t)))
+ (let* ((completion-ignore-case t)
+ (col (completing-read (or prompt "Color: ")
+ (or facemenu-color-alist
+ (defined-colors))
+ nil t)))
(if (equal "" col)
nil
col)))
(cons face
(if (listp prev)
prev
- (list prev)))))))
+ (list prev)))
+ ;; Specify the selected frame
+ ;; because nil would mean to use
+ ;; the new-frame default settings,
+ ;; and those are usually nil.
+ (selected-frame)))))
(setq part-start part-end)))
(setq self-insert-face (if (eq last-command self-insert-face-command)
(cons face (if (listp self-insert-face)
(nreverse active-list)))
(defun facemenu-add-new-face (face)
- "Add FACE (a face) to the Face menu.
-
-This is called whenever you create a new face."
+ "Add FACE (a face) to the Face menu if `facemenu-listed-faces' says so.
+This is called whenever you create a new face, and at other times."
(let* (name
symbol
menu docstring
(setq docstring
(format "Select face `%s' for subsequent insertion."
name))
- (cond ((eq t facemenu-unlisted-faces))
- ((memq symbol facemenu-unlisted-faces))
- ;; test against regexps in facemenu-unlisted-faces
- ((let ((unlisted facemenu-unlisted-faces)
- (matched nil))
- (while (and unlisted (not matched))
- (if (and (stringp (car unlisted))
- (string-match (car unlisted) name))
- (setq matched t)
- (setq unlisted (cdr unlisted))))
- matched))
- (key ; has a keyboard equivalent. These go at the front.
+ (cond ((facemenu-iterate ; check if equivalent face is already in the menu
+ (lambda (m) (and (listp m)
+ (symbolp (car m))
+ ;; Avoid error in face-equal
+ ;; when a non-face is erroneously present.
+ (facep (car m))
+ (face-equal (car m) symbol)))
+ (cdr (symbol-function menu))))
+ ;; Faces with a keyboard equivalent. These go at the front.
+ (key
(setq function (intern (concat "facemenu-set-" name)))
(fset function
`(lambda ()
(region-end)))))
(define-key 'facemenu-keymap key (cons name function))
(define-key menu key (cons name function)))
- ((facemenu-iterate ; check if equivalent face is already in the menu
- (lambda (m) (and (listp m)
- (symbolp (car m))
- (face-equal (car m) symbol)))
- (cdr (symbol-function menu))))
- (t ; No keyboard equivalent. Figure out where to put it:
+ ;; Faces with no keyboard equivalent. Figure out where to put it:
+ ((or (eq t facemenu-listed-faces)
+ (memq symbol facemenu-listed-faces))
(setq key (vector symbol)
function 'facemenu-set-face-from-menu
menu-val (symbol-function menu))
(if (and facemenu-new-faces-at-end
- (> (length menu-val) 3))
+ (> (length menu-val) 3))
(define-key-after menu-val key (cons name function)
(car (nth (- (length menu-val) 3) menu-val)))
(define-key menu key (cons name function))))))