djavu-asus/solarized-theme-utils.el

   1 ;;; solarized-theme-utils.el --- Utilities for solarized theme development  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2012 Thomas Frössman
   4
   5 ;; Author: Thomas Frössman <thomasf@jossystem.se>
   6 ;; URL: http://github.com/bbatsov/solarized-emacs
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22 ;;
  23 ;; Development utilities, these are not needed for normal theme usage
  24 ;;
  25
  26 ;;;; Code:
  27 (require 'cl-lib)
  28 (require 'solarized)
  29
  30 (defun solarized-import-faces (&optional regexp already-defined)
  31   "Imports current effective face definitions by regular expression
  32 in the format of solarized-theme.el."
  33   (interactive (list (read-regexp "List faces matching regexp")))
  34   (let*
  35       ((all-faces (zerop (length regexp)))
  36        (faces
  37         (delq nil
  38               (mapcar (lambda (face)
  39                         (let ((s (symbol-name face)))
  40                           (when (or all-faces (string-match regexp s))
  41                             face)))
  42                       (sort (face-list) #'string-lessp)))))
  43     (mapc (lambda(face)
  44             (when (or (not (get face 'theme-face)) already-defined)
  45               (insert (format
  46                        "`(%s ((,class %s)))%s
  47 "
  48                        face
  49                        (let (result)
  50                          (dolist (entry face-attribute-name-alist result)
  51                            (let* ((attribute (car entry))
  52                                   (value (face-attribute face attribute)))
  53                              (unless (eq value 'unspecified)
  54                                (setq result
  55                                      (nconc (list attribute
  56                                                   (cond
  57                                                    ((cl-member attribute
  58                                                                '(":background"
  59                                                                  ":foreground")
  60                                                                :test 'string=)
  61                                                     (format "\"%s\"" value))
  62                                                    (t value))) result))))))
  63                        (if (get face 'theme-face)
  64                            (format " ;; Already set by current theme!")
  65                          "")))))
  66           faces)))
  67
  68 (provide 'solarized-theme-utils)
  69
  70 ;; Local Variables:
  71 ;; byte-compile-warnings: (not cl-functions)
  72 ;; indent-tabs-mode: nil
  73 ;; End:
  74
  75 ;;; solarized-theme-utils.el ends here