solarized-emacs

a fork of Bozhidar Batsov's solarized-emacs
git clone https://git.trogloxene.org/solarized-emacs.git
Log | Files | Refs | README

solarized-theme-utils.el (3099B)

      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   "Import current effective face definitions by regular expression.
     32 The output is 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