Function: custom-save-faces

custom-save-faces is a byte-compiled function defined in cus-edit.el.gz.

Signature

(custom-save-faces)

Documentation

Save all customized faces in custom-file(var)/custom-file(fun).

Source Code

;; Defined in /usr/src/emacs/lisp/cus-edit.el.gz
(defun custom-save-faces ()
  "Save all customized faces in `custom-file'."
  (save-excursion
    (custom-save-delete 'custom-reset-faces)
    (custom-save-delete 'custom-set-faces)
    (let ((standard-output (current-buffer))
	  (saved-list (make-list 1 0)))
      ;; First create a sorted list of saved faces.
      (mapatoms
       (lambda (symbol)
	 (if (and (get symbol 'saved-face)
		  (eq 'user (car (car-safe (get symbol 'theme-face)))))
	     (nconc saved-list (list symbol)))))
      (setq saved-list (sort (cdr saved-list) 'string<))
      ;; The default face must be first, since it affects the others.
      (if (memq 'default saved-list)
	  (setq saved-list (cons 'default (delq 'default saved-list))))
      (unless (bolp)
	(princ "\n"))
      (princ "(custom-set-faces
 ;; custom-set-faces was added by Custom.
 ;; If you edit it by hand, you could mess it up, so be careful.
 ;; Your init file should contain only one such instance.
 ;; If there is more than one, they won't work right.\n")
      (dolist (symbol saved-list)
	(let ((spec (car-safe (get symbol 'theme-face)))
	      (value (get symbol 'saved-face))
	      (now (not (or (get symbol 'face-defface-spec)
                            (and (not (facep symbol))
				 (not (get symbol 'force-face))))))
	      (comment (get symbol 'saved-face-comment)))
	  (when (or (and spec (eq (nth 0 spec) 'user))
		    comment
		    (and (null spec) (get symbol 'saved-face)))
	    ;; Don't print default face here.
	    (unless (bolp)
	      (princ "\n"))
	    (princ " '(")
	    (prin1 symbol)
	    (princ " ")
	    (prin1 value)
	    (when (or now comment)
	      (princ " ")
	      (prin1 now)
	      (when comment
		(princ " ")
		(prin1 comment)))
	    (princ ")"))))
      (if (bolp)
	  (princ " "))
      (princ ")")
      (when (/= (following-char) ?\n)
	(princ "\n")))))