(define-key global-map [C-down-mouse-2] 'facemenu-menu)
(define-key global-map "\M-g" 'facemenu-keymap)
-(defvar facemenu-keybindings
+(defgroup facemenu nil
+ "Create a face menu for interactively adding fonts to text"
+ :group 'faces
+ :prefix "facemenu-")
+
+(defcustom facemenu-keybindings
'((default . "d")
(bold . "b")
(italic . "i")
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.")
+`facemenu-update' to make it take effect."
+ :type '(repeat (cons face string))
+ :group 'facemenu)
-(defvar facemenu-new-faces-at-end t
+(defcustom facemenu-new-faces-at-end t
"*Where in the menu to insert newly-created faces.
This should be nil to put them at the top of the menu, or t to put them
-just before \"Other\" at the end.")
-
-(defvar facemenu-unlisted-faces
- '(modeline region secondary-selection highlight scratch-face)
+just before \"Other\" at the end."
+ :type 'boolean
+ :group 'facemenu)
+
+(defcustom facemenu-unlisted-faces
+ '(modeline region secondary-selection highlight scratch-face
+ "^font-lock-" "^gnus-" "^message-" "^ediff-" "^term-" "^vc-"
+ "^widget-" "^custom-" "^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,
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.")
+when they are created."
+ :type '(choice (const :tag "Don't add" t)
+ (const :tag "None" nil)
+ (repeat (choice symbol regexp)))
+ :group 'facemenu)
;;;###autoload
(defvar facemenu-face-menu
(define-key map [dc] (cons "Display Colors" 'list-colors-display))
(define-key map [df] (cons "Display Faces" 'list-faces-display))
(define-key map [dp] (cons "List Properties" 'list-text-properties-at))
- (define-key map [ra] (cons "Remove All" 'facemenu-remove-all))
- (define-key map [rm] (cons "Remove Properties" 'facemenu-remove-props))
+ (define-key map [ra] (cons "Remove Text Properties" 'facemenu-remove-all))
+ (define-key map [rm] (cons "Remove Face Properties" 'facemenu-remove-face-props))
(define-key map [s1] (list "-----------------")))
;;;###autoload
(let ((map facemenu-menu))
(defalias 'facemenu-keymap facemenu-keymap)
-(defvar facemenu-add-face-function nil
+(defcustom facemenu-add-face-function nil
"Function called at beginning of text to change or `nil'.
This function is passed the FACE to set and END of text to change, and must
-return a string which is inserted. It may set `facemenu-end-add-face'.")
+return a string which is inserted. It may set `facemenu-end-add-face'."
+ :type '(choice (const :tag "None" nil)
+ function)
+ :group 'facemenu)
-(defvar facemenu-end-add-face nil
+(defcustom facemenu-end-add-face nil
"String to insert or function called at end of text to change or `nil'.
This function is passed the FACE to set, and must return a string which is
-inserted.")
+inserted."
+ :type '(choice (const :tag "None" nil)
+ string
+ function)
+ :group 'facemenu)
-(defvar facemenu-remove-face-function nil
+(defcustom facemenu-remove-face-function nil
"When non-nil, this is a function called to remove faces.
This function is passed the START and END of text to change.
-May also be `t' meaning to use `facemenu-add-face-function'.")
+May also be `t' meaning to use `facemenu-add-face-function'."
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Use add-face" t)
+ function)
+ :group 'facemenu)
;;; Internal Variables
(add-text-properties start end '(read-only t)))
;;;###autoload
-(defun facemenu-remove-props (start end)
- "Remove all text properties that facemenu added to region."
+(defun facemenu-remove-face-props (start end)
+ "Remove `face' and `mouse-face' text properties."
(interactive "*r") ; error if buffer is read-only despite the next line.
(let ((inhibit-read-only t))
(remove-text-properties
- start end '(face nil invisible nil intangible nil
- read-only nil category nil))))
+ start end '(face nil mouse-face nil))))
;;;###autoload
(defun facemenu-remove-all (start end)
(with-output-to-temp-buffer "*Colors*"
(save-excursion
(set-buffer standard-output)
- (let ((facemenu-unlisted-faces t)
- s)
+ (let (s)
(while list
(setq s (point))
(insert (car list))
(indent-to 20)
(put-text-property s (point) 'face
- (facemenu-get-face
- (intern (concat "bg:" (car list)))))
+ (cons 'background-color (car list)))
(setq s (point))
(insert " " (car list) "\n")
(put-text-property s (point) 'face
- (facemenu-get-face
- (intern (concat "fg:" (car list)))))
+ (cons 'foreground-color (car list)))
(setq list (cdr list)))))))
(defun facemenu-color-equal (a b)
(defun facemenu-get-face (symbol)
"Make sure FACE exists.
-If not, it is created. If it is created and is of the form `fg:color', then
-set the foreground to that color. If of the form `bg:color', set the
-background. In any case, add it to the appropriate menu. Returns the face,
-or nil if given a bad color."
- (if (or (internal-find-face symbol)
- (let* ((face (make-face symbol))
- (name (symbol-name symbol))
+If not, create it and add it to the appropriate menu. Return the symbol.
+
+If a window system is in use, and this function creates a face named
+`fg:color', then it sets the foreground to that color. Likewise, `bg:color'
+means to set the background. In either case, if the color is undefined,
+no color is set and a warning is issued."
+ (let ((name (symbol-name symbol))
+ foreground)
+ (cond ((internal-find-face symbol))
+ ((and window-system
+ (or (setq foreground (string-match "^fg:" name))
+ (string-match "^bg:" name)))
+ (let ((face (make-face symbol))
(color (substring name 3)))
- (cond ((string-match "^fg:" name)
- (set-face-foreground face color)
- (and window-system
- (x-color-defined-p color)))
- ((string-match "^bg:" name)
- (set-face-background face color)
- (and window-system
- (x-color-defined-p color)))
- (t))))
- symbol))
+ (if (x-color-defined-p color)
+ (if foreground
+ (set-face-foreground face color)
+ (set-face-background face color))
+ (message "Color \"%s\" undefined" color))))
+ (t (make-face symbol))))
+ symbol)
(defun facemenu-add-new-face (face)
"Add a FACE to the appropriate Face menu.
(setq menu 'facemenu-face-menu)))
(cond ((eq t facemenu-unlisted-faces))
((memq face 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.
(setq function (intern (concat "facemenu-set-" name)))
(fset function
`(lambda ()
,docstring
(interactive)
- (facemenu-set-face (quote (, face)))))
+ (facemenu-set-face (quote ,face))))
(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