Function: facemenu-add-new-face

facemenu-add-new-face is a byte-compiled function defined in facemenu.el.gz.

Signature

(facemenu-add-new-face FACE)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/facemenu.el.gz
(defun facemenu-add-new-face (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
	 (key (cdr (assoc face facemenu-keybindings)))
	 function menu-val)
    (if (symbolp face)
	(setq name (symbol-name face)
	      symbol face)
      (setq name face
	    symbol (intern name)))
    (setq menu 'facemenu-face-menu)
    (setq docstring
	  (format "Select face `%s' for subsequent insertion.
If the mark is active and there is no prefix argument,
apply face `%s' to the region instead.
This command was defined by `facemenu-add-new-face'."
		  name name))
    (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 ()
		   (:documentation docstring)
		   (interactive)
		   (facemenu-set-face
		    symbol
		    (if (and mark-active (not current-prefix-arg))
			(region-beginning))
		    (if (and mark-active (not current-prefix-arg))
			(region-end)))))
	   (define-key 'facemenu-keymap key (cons name function))
	   (define-key menu key (cons name function)))
	  ;; 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))
	       (define-key-after menu-val key (cons name function)
		 (car (nth (- (length menu-val) 3) menu-val)))
	     (define-key menu key (cons name function))))))
  nil) ; Return nil for facemenu-iterate