+ (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+ (custom-theme--load-path)
+ '("" "c")))
+ hash)
+ (unless fn
+ (error "Unable to find theme file for `%s'" theme))
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (setq hash (sha1 (current-buffer)))
+ ;; Check file safety with `custom-safe-themes', prompting the
+ ;; user if necessary.
+ (when (or no-confirm
+ (and (memq 'default custom-safe-themes)
+ (equal (file-name-directory fn)
+ (expand-file-name "themes/" data-directory)))
+ (member hash custom-safe-themes)
+ (custom-theme-load-confirm hash))
+ (let ((custom--inhibit-theme-enable t))
+ (eval-buffer))
+ ;; Optimization: if the theme changes the `default' face, put that
+ ;; entry first. This avoids some `frame-set-background-mode' rigmarole
+ ;; by assigning the new background immediately.
+ (let* ((settings (get theme 'theme-settings))
+ (tail settings)
+ found)
+ (while (and tail (not found))
+ (and (eq (nth 0 (car tail)) 'theme-face)
+ (eq (nth 1 (car tail)) 'default)
+ (setq found (car tail)))
+ (setq tail (cdr tail)))
+ (if found
+ (put theme 'theme-settings (cons found (delq found settings)))))
+ ;; Finally, enable the theme.
+ (unless no-enable
+ (enable-theme theme))
+ t))))
+
+(defun custom-theme-load-confirm (hash)
+ "Query the user about loading a Custom theme that may not be safe.
+The theme should be in the current buffer. If the user agrees,
+query also about adding HASH to `custom-safe-themes'."
+ (if noninteractive
+ nil
+ (let ((exit-chars '(?y ?n ?\s))
+ window prompt char)
+ (save-window-excursion
+ (rename-buffer "*Custom Theme*" t)
+ (emacs-lisp-mode)
+ (setq window (display-buffer (current-buffer)))
+ (setq prompt
+ (format "Loading a theme can run Lisp code. Really load?%s"
+ (if (and window
+ (< (line-number-at-pos (point-max))
+ (window-body-height)))
+ " (y or n) "
+ (push ?\C-v exit-chars)
+ "\nType y or n, or C-v to scroll: ")))
+ (goto-char (point-min))
+ (while (null char)
+ (setq char (read-char-choice prompt exit-chars))
+ (when (eq char ?\C-v)
+ (if window
+ (with-selected-window window
+ (condition-case nil
+ (scroll-up)
+ (error (goto-char (point-min))))))
+ (setq char nil)))
+ (when (memq char '(?\s ?y))
+ ;; Offer to save to `custom-safe-themes'.
+ (and (or custom-file user-init-file)
+ (y-or-n-p "Treat this theme as safe in future sessions? ")
+ (customize-push-and-save 'custom-safe-themes (list hash)))
+ t)))))
+
+(defun custom-theme-name-valid-p (name)
+ "Return t if NAME is a valid name for a Custom theme, nil otherwise.
+NAME should be a symbol."
+ (and (symbolp name)
+ name
+ (not (or (zerop (length (symbol-name name)))
+ (eq name 'user)
+ (eq name 'changed)))))
+
+(defun custom-available-themes ()
+ "Return a list of available Custom themes (symbols)."
+ (let (sym themes)
+ (dolist (dir (custom-theme--load-path))
+ (when (file-directory-p dir)
+ (dolist (file (file-expand-wildcards
+ (expand-file-name "*-theme.el" dir) t))
+ (setq file (file-name-nondirectory file))
+ (and (string-match "\\`\\(.+\\)-theme.el\\'" file)
+ (setq sym (intern (match-string 1 file)))
+ (custom-theme-name-valid-p sym)
+ (push sym themes)))))
+ (nreverse (delete-dups themes))))
+
+(defun custom-theme--load-path ()
+ (let (lpath)
+ (dolist (f custom-theme-load-path)
+ (cond ((eq f 'custom-theme-directory)
+ (setq f custom-theme-directory))
+ ((eq f t)
+ (setq f (expand-file-name "themes" data-directory))))
+ (if (file-directory-p f)
+ (push f lpath)))
+ (nreverse lpath)))
+