]> crepu.dev Git - config.git/blob - djavu-asus/solarized-theme-utils.el
Actualizado el Readme
[config.git] / 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