;;; cus-theme.el -- custom theme creation user interface
;;
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
;;
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
(defvar custom-new-theme-mode-map
(let ((map (make-keymap)))
- (set-keymap-parent map widget-keymap)
+ (set-keymap-parent map (make-composed-keymap widget-keymap
+ special-mode-map))
(suppress-keymap map)
(define-key map "\C-x\C-s" 'custom-theme-write)
+ (define-key map "q" 'Custom-buffer-done)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
map)
(defun customize-create-theme (&optional theme buffer)
"Create or edit a custom theme.
THEME, if non-nil, should be an existing theme to edit. If THEME
-is `user', provide an option to remove these as custom settings.
+is `user', the resulting *Custom Theme* buffer also contains a
+checkbox for removing the theme settings specified in the buffer
+from the Custom save file.
BUFFER, if non-nil, should be a buffer to use; the default is
named *Custom Theme*."
(interactive)
(make-local-variable 'custom-theme-insert-face-marker)
(make-local-variable 'custom-theme-insert-variable-marker)
(make-local-variable 'custom-theme--listed-faces)
+ (when (called-interactively-p 'interactive)
+ (unless (y-or-n-p "Include basic face customizations in this theme? ")
+ (setq custom-theme--listed-faces nil)))
(if (eq theme 'user)
(widget-insert "This buffer contains all the Custom settings you have made.
(widget-create 'push-button
:tag " Visit Theme "
:help-echo "Insert the settings of a pre-defined theme."
- :action (lambda (widget &optional event)
+ :action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-visit-theme)))
(widget-insert " ")
(widget-create 'push-button
:tag " Merge Theme "
:help-echo "Merge in the settings of a pre-defined theme."
- :action (lambda (widget &optional event)
+ :action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-merge-theme)))
(widget-insert " ")
(widget-create 'push-button
;; Load the theme settings.
(when theme
(unless (eq theme 'user)
- (load-theme theme t))
+ (load-theme theme nil t))
(dolist (setting (get theme 'theme-settings))
(if (eq (car setting) 'theme-value)
(progn (push (nth 1 setting) vars)
:button-face 'custom-link
:mouse-face 'highlight
:pressed-face 'highlight
- :action (lambda (widget &optional event)
+ :action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-add-face)))
;; If THEME is non-nil, insert all of that theme's variables.
(while vars
(if (eq (car vars) 'custom-enabled-themes)
(progn (pop vars) (pop values))
- (custom-theme-add-var-1 (pop vars) (pop values)))))
+ (custom-theme-add-var-1 (pop vars) (eval (pop values))))))
(setq custom-theme-insert-variable-marker (point-marker))
(widget-insert " ")
(widget-create 'push-button
:button-face 'custom-link
:mouse-face 'highlight
:pressed-face 'highlight
- :action (lambda (widget &optional event)
+ :action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-add-variable)))
(widget-insert ?\n)
(widget-setup)
(goto-char (point-min))
(message "")))
-(defun custom-theme-revert (ignore-auto noconfirm)
+(defun custom-theme-revert (_ignore-auto noconfirm)
+ "Revert the current *Custom Theme* buffer.
+This is the `revert-buffer-function' for `custom-new-theme-mode'."
(when (or noconfirm (y-or-n-p "Discard current changes? "))
(customize-create-theme custom-theme--save-name (current-buffer))))
(defun custom-theme-add-face (face &optional spec)
"Add a widget for FACE (a symbol) to the *New Custom Theme* buffer.
SPEC, if non-nil, should be a face spec to which to set the widget."
- (interactive (list (read-face-name "Face name" nil nil) nil))
+ (interactive (list (read-face-name "Face name" (face-at-point t))))
(unless (or (facep face) spec)
(error "`%s' has no face definition" face))
(let ((entry (assq face custom-theme-faces)))
;;; Reading and writing
+;;;###autoload
(defun custom-theme-visit-theme (theme)
- "Load the custom theme THEME's settings into the current buffer."
+ "Set up a Custom buffer to edit custom theme THEME."
(interactive
(list
(intern (completing-read "Find custom theme: "
(unless (eq theme 'user)
(unless (custom-theme-name-valid-p theme)
(error "Invalid theme name `%s'" theme))
- (load-theme theme t))
+ (load-theme theme nil t))
(let ((settings (reverse (get theme 'theme-settings))))
(dolist (setting settings)
- (funcall (if (eq (car setting) 'theme-value)
- 'custom-theme-add-variable
- 'custom-theme-add-face)
- (nth 1 setting)
- (nth 3 setting))))
+ (let ((option (eq (car setting) 'theme-value))
+ (name (nth 1 setting))
+ (value (nth 3 setting)))
+ (unless (and option
+ (memq name '(custom-enabled-themes
+ custom-safe-themes)))
+ (funcall (if option
+ 'custom-theme-add-variable
+ 'custom-theme-add-face)
+ name value)))))
theme)
-(defun custom-theme-write (&rest ignore)
+;; From cus-edit.el
+(defvar custom-reset-standard-faces-list)
+(defvar custom-reset-standard-variables-list)
+
+(defun custom-theme-write (&rest _ignore)
"Write the current custom theme to its theme file."
(interactive)
(let* ((name (widget-value custom-theme-name))
(princ theme)
(princ "\n")
(dolist (spec faces)
+ ;; Insert the face iff the checkbox widget is checked.
(when (widget-get (nth 1 spec) :value)
(let* ((symbol (nth 0 spec))
(widget (nth 2 spec))
(value
- (if (car-safe (widget-get widget :children))
- (custom-face-widget-to-spec widget)
- ;; Child is null if the widget is closed (hidden).
- (widget-get widget :shown-value))))
+ (cond
+ ((car-safe (widget-get widget :children))
+ (custom-face-widget-to-spec widget))
+ ;; Child is null if the widget is closed (hidden).
+ ((widget-get widget :shown-value))
+ (t (custom-face-get-current-spec symbol)))))
(when (and (facep symbol) value)
(princ (if (bolp) " '(" "\n '("))
(prin1 symbol)
'help-theme-def fn)
(princ "'"))
(princ ".\n")
- (if (not (memq theme custom-known-themes))
+ (if (custom-theme-p theme)
(progn
- (princ "It is not loaded.")
- ;; Attempt to grab the theme documentation
- (when fn
- (with-temp-buffer
- (insert-file-contents fn)
- (let ((sexp (let ((read-circle nil))
- (condition-case nil
- (read (current-buffer))
- (end-of-file nil)))))
- (and sexp (listp sexp)
- (eq (car sexp) 'deftheme)
- (setq doc (nth 2 sexp)))))))
- (if (custom-theme-enabled-p theme)
- (princ "It is loaded and enabled.")
- (princ "It is loaded but disabled."))
- (setq doc (get theme 'theme-documentation)))
-
+ (if (custom-theme-enabled-p theme)
+ (princ "It is loaded and enabled.")
+ (princ "It is loaded but disabled."))
+ (setq doc (get theme 'theme-documentation)))
+ (princ "It is not loaded.")
+ ;; Attempt to grab the theme documentation
+ (when fn
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (let ((sexp (let ((read-circle nil))
+ (condition-case nil
+ (read (current-buffer))
+ (end-of-file nil)))))
+ (and sexp (listp sexp)
+ (eq (car sexp) 'deftheme)
+ (setq doc (nth 2 sexp)))))))
(princ "\n\nDocumentation:\n")
(princ (if (stringp doc)
doc
(defcustom custom-theme-allow-multiple-selections nil
"Whether to allow multi-selections in the *Custom Themes* buffer."
+ :version "24.1"
:type 'boolean
:group 'custom-buffer)
(defvar custom-theme-choose-mode-map
(let ((map (make-keymap)))
- (set-keymap-parent map widget-keymap)
+ (set-keymap-parent map (make-composed-keymap widget-keymap
+ special-mode-map))
(suppress-keymap map)
(define-key map "\C-x\C-s" 'custom-theme-save)
(define-key map "n" 'widget-forward)
map)
"Keymap for `custom-theme-choose-mode'.")
-(define-derived-mode custom-theme-choose-mode nil "Themes"
+(define-derived-mode custom-theme-choose-mode special-mode "Themes"
"Major mode for selecting Custom themes.
Do not call this mode function yourself. It is meant for internal use."
(use-local-map custom-theme-choose-mode-map)
(custom--initialize-widget-variables)
(set (make-local-variable 'revert-buffer-function)
- (lambda (ignore-auto noconfirm)
+ (lambda (_ignore-auto noconfirm)
(when (or noconfirm (y-or-n-p "Discard current choices? "))
(customize-themes (current-buffer))))))
(put 'custom-theme-choose-mode 'mode-class 'special)
:help-echo "Describe `custom-theme-load-path'."
:keymap custom-mode-link-map
:follow-link 'mouse-face
- :action (lambda (widget &rest ignore)
+ :action (lambda (_widget &rest _ignore)
(describe-variable 'custom-theme-load-path)))
(widget-insert "'.\n\n")
:help-echo "Migrate."
:keymap custom-mode-link-map
:follow-link 'mouse-face
- :action (lambda (widget &rest ignore)
+ :action (lambda (_widget &rest _ignore)
(customize-create-theme 'user)))
(widget-insert ".\n\n")))
(widget-create 'checkbox
:value custom-theme-allow-multiple-selections
:action 'custom-theme-selections-toggle)
- (widget-insert (propertize " Allow more than one theme at a time"
+ (widget-insert (propertize " Select more than one theme at a time"
'face '(variable-pitch (:height 0.9))))
(widget-insert "\n\nAvailable Custom Themes:\n")
- (let (widget)
+ (let ((help-echo "mouse-2: Enable this theme for this session")
+ widget)
(dolist (theme (custom-available-themes))
(setq widget (widget-create 'checkbox
:value (custom-theme-enabled-p theme)
:theme-name theme
+ :help-echo help-echo
:action 'custom-theme-checkbox-toggle))
(push (cons theme widget) custom--listed-themes)
(widget-create-child-and-convert widget 'push-button
:button-face-get 'ignore
:mouse-face-get 'ignore
:value (format " %s" theme)
- :action 'widget-parent-action)
- (widget-insert ?\n)))
+ :action 'widget-parent-action
+ :help-echo help-echo)
+ (widget-insert " -- "
+ (propertize (custom-theme-summary theme)
+ 'face 'shadow)
+ ?\n)))
(goto-char (point-min))
(widget-setup))
+(defun custom-theme-summary (theme)
+ "Return the summary line of THEME."
+ (let (doc)
+ (if (custom-theme-p theme)
+ (setq doc (get theme 'theme-documentation))
+ (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+ (custom-theme--load-path)
+ '("" "c"))))
+ (when fn
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (let ((sexp (let ((read-circle nil))
+ (condition-case nil
+ (read (current-buffer))
+ (end-of-file nil)))))
+ (and sexp (listp sexp)
+ (eq (car sexp) 'deftheme)
+ (setq doc (nth 2 sexp))))))))
+ (cond ((null doc)
+ "(no documentation available)")
+ ((string-match ".*" doc)
+ (match-string 0 doc))
+ (t doc))))
+
(defun custom-theme-checkbox-toggle (widget &optional event)
(let ((this-theme (widget-get widget :theme-name)))
(if (widget-value widget)
(and widget
(describe-theme (widget-get widget :theme-name)))))
-(defun custom-theme-save (&rest ignore)
+(defun custom-theme-save (&rest _ignore)
(interactive)
(customize-save-variable 'custom-enabled-themes custom-enabled-themes)
(message "Custom themes saved for future sessions."))
(widget-toggle-action widget event)
(setq custom-theme-allow-multiple-selections (widget-value widget)))
+(provide 'cus-theme)
+
;;; cus-theme.el ends here
HCoop / bpt / emacs.git / blobdiff