;;; custom.el --- tools for declaring and initializing options
;;
-;; Copyright (C) 1996, 1997, 1999, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999, 2001-2011 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
(defvar custom-known-themes '(user changed)
"Themes that have been defined with `deftheme'.
The default value is the list (user changed). The theme `changed'
-contains the settings before custom themes are applied. The
-theme `user' contains all the settings the user customized and saved.
-Additional themes declared with the `deftheme' macro will be added to
-the front of this list.")
+contains the settings before custom themes are applied. The theme
+`user' contains all the settings the user customized and saved.
+Additional themes declared with the `deftheme' macro will be added
+to the front of this list.")
(defsubst custom-theme-p (theme)
"Non-nil when THEME has been defined."
named \"themes\" in `data-directory').
- a directory name (a string).
-Each theme file is named NAME-theme.el, where THEME is the theme
+Each theme file is named THEME-theme.el, where THEME is the theme
name."
:type '(repeat (choice (const :tag "custom-theme-directory"
custom-theme-directory)
(let ((custom-enabling-themes t))
(enable-theme 'user))))
-(defcustom custom-safe-theme-files '(default)
- "List of theme files that are considered safe to load.
-Each list element should be either an absolute file name, or the
-symbol `default', which stands for the built-in Emacs theme
-directory (a directory named \"themes\" in `data-directory'."
+(defcustom custom-safe-themes '(default)
+ "List of themes that are considered safe to load.
+Each list element should be the `sha1' hash of a theme file, or
+the symbol `default', which stands for any theme in the built-in
+Emacs theme directory (a directory named \"themes\" in
+`data-directory')."
:type '(repeat
- (choice file (const :tag "Built-in theme directory" default)))
+ (choice string (const :tag "Built-in themes" default)))
:group 'customize
+ :risky t
:version "24.1")
-(defvar safe-functions) ; From unsafep.el
-
(defun load-theme (theme &optional no-enable)
- "Load a theme's settings from its file.
-Normally, this also enables the theme; use `disable-theme' to
-disable it. If optional arg NO-ENABLE is non-nil, don't enable
-the theme.
+ "Load Custom theme named THEME from its file.
+Normally, this also enables THEME. If optional arg NO-ENABLE is
+non-nil, load THEME but don't enable it.
+
+The theme file is named THEME-theme.el, in one of the directories
+specified by `custom-theme-load-path'.
-A theme file is named THEME-theme.el, where THEME is the theme name,
-in one of the directories specified by `custom-theme-load-path'."
+Return t if THEME was successfully loaded, nil otherwise."
(interactive
(list
(intern (completing-read "Load custom theme: "
(put theme 'theme-documentation nil))
(let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
- '("" "c"))))
+ '("" "c")))
+ hash)
(unless fn
- (error "Unable to find theme file for `%s'." theme))
- ;; Check file safety.
- (when (or (and (memq 'default custom-safe-theme-files)
- (equal (file-name-directory fn)
- (expand-file-name "themes/" data-directory)))
- (member fn custom-safe-theme-files)
- ;; If the file is not in the builtin theme directory or
- ;; in `custom-safe-theme-files', check it with unsafep.
- (with-temp-buffer
- (require 'unsafep)
- (insert-file-contents fn)
- (let ((safe-functions (append '(provide-theme deftheme
- custom-theme-set-variables
- custom-theme-set-faces)
- safe-functions))
- unsafep form)
- (while (and (setq form (condition-case nil
- (let ((read-circle nil))
- (read (current-buffer)))
- (end-of-file nil)))
- (null (setq unsafep (unsafep form)))))
- (or (null unsafep)
- (custom-theme-load-confirm fn)))))
- (let ((custom--inhibit-theme-enable no-enable))
- (load fn)))))
-
-(defun custom-theme-load-confirm (filename)
+ (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 (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 no-enable))
+ (eval-buffer)
+ 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 ((existing-buffer (find-buffer-visiting filename))
- (exit-chars '(?y ?n ?\s ?\C-g))
- prompt char)
+ (let ((exit-chars '(?y ?n ?\s))
+ window prompt char)
(save-window-excursion
- (if existing-buffer
- (pop-to-buffer existing-buffer)
- (find-file filename))
- (unwind-protect
- (progn
- (setq prompt
- (format "This theme is not guaranteed to be safe. Really load? %s"
- (if (< (line-number-at-pos (point-max))
- (window-body-height))
- "(y or n) "
- (push ?\C-v exit-chars)
- "Type y or n, or C-v to scroll: ")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars t))
- (when (eq char ?\C-v)
+ (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))
- (push filename custom-safe-theme-files)
- ;; Offer to save to `custom-safe-theme-files'.
- (and (or custom-file user-init-file)
- (y-or-n-p "Treat %s as safe for future loads? "
- (file-name-nondirectory filename))
- (let ((coding-system-for-read nil))
- (customize-save-variable
- 'custom-safe-theme-files
- custom-safe-theme-files)))
- t))
- ;; Unwind form.
- (unless existing-buffer (kill-buffer)))))))
+ (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? ")
+ (let ((coding-system-for-read nil))
+ (push hash custom-safe-themes)
+ (customize-save-variable 'custom-safe-themes
+ custom-safe-themes)))
+ t)))))
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.
(defun custom-available-themes ()
"Return a list of available Custom themes (symbols)."
- (let* (sym themes)
+ (let (sym themes)
(dolist (dir (custom-theme--load-path))
(when (file-directory-p dir)
(dolist (file (file-expand-wildcards
(setq sym (intern (match-string 1 file)))
(custom-theme-name-valid-p sym)
(push sym themes)))))
- (delete-dups themes)))
+ (nreverse (delete-dups themes))))
(defun custom-theme--load-path ()
(let (lpath)
and always takes precedence over other Custom Themes."
:group 'customize
:type '(repeat symbol)
- :set-after '(custom-theme-directory custom-theme-load-path)
+ :set-after '(custom-theme-directory custom-theme-load-path
+ custom-safe-themes)
:risky t
:set (lambda (symbol themes)
;; Avoid an infinite loop when custom-enabled-themes is
currently enabled custom themes.
This function returns nil if no custom theme specifies a value for VARIABLE."
- (let* ((theme-value (get variable 'theme-value)))
+ (let ((theme-value (get variable 'theme-value)))
(if theme-value
(cdr (car theme-value)))))
(provide 'custom)
-;; arch-tag: 041b6116-aabe-4f9a-902d-74092bc3dab2
;;; custom.el ends here
HCoop / bpt / emacs.git / blobdiff