;;; color-theme-buffer-local.el --- Install color-themes by buffer. ;;; Name: color-theme-buffer-local ;;; Version: 0.0.3 ;; Package-Version: 20170125.2201 ;;; Author: Victor Borja ;;; URL: http://github.com/vic/color-theme-buffer-local ;;; Description: Set color-theme by buffer. ;;; Keywords: faces ;;; Package-Requires: ((color-theme "0")) ;;; Dependencies: ((color-theme)) ;; This file is not part of GNU Emacs. Licensed on the same terms as ;; GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; ;;; Usage for color-theme.el themes: ;;; ;;; (add-hook 'java-mode-hook (lambda nil ;;; (color-theme-buffer-local 'color-theme-robin-hood (current-buffer)))) ;;; (require 'color-theme) (defun color-theme-buffer-local-install-variables (vars buffer) (with-current-buffer buffer (let ((vars (color-theme-filter vars color-theme-legal-variables))) (dolist (var vars) (set (make-variable-buffer-local (car var)) (cdr var)))))) (defun color-theme-buffer-local-reset-faces (buffer) (with-current-buffer buffer (dolist (face (color-theme-get-faces)) (make-variable-buffer-local 'face-remapping-alist) (face-remap-reset-base face)))) (defun color-theme-buffer-local-spec-compat (spec) (let ((props (cadar spec))) ;; remove stipple attribute because it causes error :( FIXME (when (plist-member props :stipple) (setq props (color-theme-plist-delete props :stipple))) `((t ,props)))) (defun color-theme-buffer-local-install-face (face spec) (or (facep face) (make-empty-face face)) ;; remove weird properties from the default face only (when (eq face 'default) (setq spec (color-theme-spec-filter spec))) ;; Emacs/XEmacs customization issues: filter out :bold when ;; the spec contains :weight, etc, such that the spec remains ;; "valid" for custom. (setq spec (color-theme-spec-compat spec)) ;; using a spec of ((t (nil))) to reset a face doesn't work ;; in Emacs 21, we use the new function face-spec-reset-face ;; instead (setq spec (color-theme-buffer-local-spec-compat spec)) (if (eq 'default face) (buffer-face-set (face-spec-choose spec))) (face-remap-set-base face (face-spec-choose spec))) (defvar color-theme-buffer-local-face-alias '( (modeline . mode-line) (modeline-buffer-id . mode-line-buffer-id) (modeline-mousable . mode-line-mousable) )) (defun color-theme-buffer-local-install-faces (faces buffer) (with-current-buffer buffer (make-variable-buffer-local 'face-remapping-alist) (when (not color-theme-is-cumulative) (color-theme-buffer-local-reset-faces buffer)) (let ((faces (color-theme-filter faces color-theme-illegal-faces t))) (dolist (entry faces) (let ((face (nth 0 entry)) (spec (nth 1 entry))) (color-theme-buffer-local-install-face face spec))) (dolist (alias color-theme-buffer-local-face-alias) (when (and (assoc (car alias) faces) (not (assoc (cdr alias) faces))) (color-theme-buffer-local-install-face (cdr alias) (cadr (assoc (car alias) faces))))) ))) (defun color-theme-buffer-local-install-params (params buffer) (setq params (color-theme-filter params color-theme-legal-frame-parameters)) (make-variable-buffer-local 'buffer-face-mode-face) (let (default) (dolist (param params) (when (eq (car param) 'foreground-color) (setq default (append default (list :foreground (cdr param))))) (when (eq (car param) 'background-color) (setq default (append default (list :background (cdr param))))) ) (when default (setq default (append (if (listp buffer-face-mode-face) (cddr buffer-face-mode-face) (list buffer-face-mode-face)) (list default))) (funcall 'buffer-face-set default)))) (defun color-theme-buffer-local-install (theme buffer) (setq theme (color-theme-canonic theme)) (with-current-buffer buffer (color-theme-buffer-local-install-variables (color-theme-variables theme) buffer) (color-theme-buffer-local-install-faces (color-theme-faces theme) buffer) (color-theme-buffer-local-install-params (color-theme-frame-params theme) buffer))) ;;;###autoload (defun color-theme-buffer-local (theme &optional buffer) "Install the color-theme defined by THEME on BUFFER. THEME must be a symbol whose value as a function calls `color-theme-install' to install a theme. BUFFER defaults to the current buffer if not explicitly given." (interactive (list (intern (completing-read "Install color-theme: " (mapcar 'symbol-name (mapcar 'car color-themes)))) (read-buffer "on Buffer: " (current-buffer) t))) (flet ((color-theme-install (theme) (color-theme-buffer-local-install theme (or buffer (current-buffer))))) (funcall theme))) (provide 'color-theme-buffer-local) ;;; color-theme-buffer-local.el ends here