Function: custom-theme-write

custom-theme-write is an interactive and byte-compiled function defined in cus-theme.el.gz.

Signature

(custom-theme-write &rest IGNORE)

Documentation

Write the current custom theme to its theme file.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/cus-theme.el.gz
(defun custom-theme-write (&rest _ignore)
  "Write the current custom theme to its theme file."
  (interactive)
  (let* ((name (widget-value custom-theme-name))
	 (doc  (widget-value custom-theme-description))
	 (vars custom-theme-variables)
	 (faces custom-theme-faces)
	 filename)
    (when (string-equal name "")
      (setq name (read-from-minibuffer "Theme name: " (user-login-name)))
      (widget-value-set custom-theme-name name))
    (unless (custom-theme-name-valid-p (intern name))
      (error "Custom themes cannot be named `%s'" name))

    (setq filename (expand-file-name (concat name "-theme.el")
				     custom-theme-directory))
    (and (file-exists-p filename)
	 (not (y-or-n-p (format "File %s exists.  Overwrite? " filename)))
	 (error "Aborted"))

    (with-temp-buffer
      (emacs-lisp-mode)
      (unless (file-directory-p custom-theme-directory)
	(make-directory (file-name-as-directory custom-theme-directory) t))
      (setq buffer-file-name filename)
      (erase-buffer)
      (insert "(deftheme " name)
      (if doc (insert "\n  \"" doc "\""))
      (insert  ")\n")
      (custom-theme-write-variables name (reverse vars))
      (custom-theme-write-faces name (reverse faces))
      (insert "\n(provide-theme '" name ")\n")
      (save-buffer))
    (message "Theme written to %s" filename)

    (when custom-theme--migrate-settings
      ;; Remove these settings from the Custom file.
      (let ((custom-reset-standard-variables-list '(t))
	    (custom-reset-standard-faces-list '(t)))
	(dolist (var vars)
	  (when (and (not (eq (car var) 'custom-enabled-themes))
		     (widget-get (nth 1 var) :value))
	    (widget-apply (nth 2 var) :custom-mark-to-reset-standard)))
	(dolist (face faces)
	  (when (widget-get (nth 1 face) :value)
	    (widget-apply (nth 2 face) :custom-mark-to-reset-standard)))
	(custom-save-all))
      (let ((custom-theme-load-path (list 'custom-theme-directory)))
	(load-theme (intern name))))))