Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
704 lines (656 sloc) 19.6 KB

MetaPoet

A literate elisp document that generates all the poet themes: after a couple of attempts at writing elegant elisp I realized some literate code would be so much better for this.

Structure

(defun generate-numbered-faces (prefix start end callback)
 (mapcar
  (lambda (it)
   `(,(make-symbol (concat prefix (number-to-string it)))
     ,@(if (functionp callback) (funcall callback it) callback)))
  (number-sequence start end)))

(defun header-height (index)
  (make-symbol
   (concat "*"
           (number-to-string (max 1.23
                                  (+ .8 (/ (- 8 index) 10.0)))))))

;; Basics
`((variable-pitch
   :family variable-pitch-family
   :height *1.23)
  (default
    :background @bg
    :foreground @fg)
  (italic
   :foreground @emph
   :slant italic)
  (highlight
   :background @hlt
   :overline nil)
  (region
   :background @bg-hlt)
  (fringe
   :background @bg)
  (button
   :inherit default
   :foreground @button)
  (escape-glyph
   :foreground @glyph)
  (link
   :underline (:color @link-underline :style line)
   :foreground @link)
  (link-visited
   :inherit link
   :foreground @link
   :underline (:color @vlink-underline :style line))
  (cursor
   :background @cursor)
  (show-paren-match
   :background @paren-match-fg
   :foreground @paren-match-bg)
  (isearch
   :foreground @search-fg
   :background @search-bg)
  (isearch-fail
   :background @search-fail-bg)
  (query-replace
   :inherit isearch)
  (tooltip
   :inherit default
   :foreground @tooltip-fg
   :background @tooltip-bg)
  (shadow
   :foreground @shadow)
  (secondary-selection
   :background @secondary-bg)
  (trailing-whitespace
   :background @trailing-bg)
  (lazy-highlight
   :foreground @lazy-hlt-fg
   :background @lazy-hlt-bg)
  (next-error
   :inherit region)
  (window-divider
   :background @sep
   :foreground @sep)
  (vertical-border
   :background @sep
   :foreground @sep)

;; Evil
  (evil-ex-substitute-replacement
   :foreground @evil-rep-fg
   :background @evil-rep-bg
   :underline nil)

;; Minibuffer
  (minibuffer-prompt
   :inherit fixed-pitch
   :weight bold
   :foreground @meta)

 ;; Mode Line
  (mode-line
   :inherit fixed-pitch
   :foreground @mode-line-fg
   :background @bg
   :overline @sep
   :box (:line-width 3 :color @bg))
  (header-line
   :overline nil
   :background @header-line-bg
   :box (:line-width 3 :color @header-line-bg)
   :underline @sep
   :inherit mode-line)
  (mode-line-buffer-id
   :weight bold)
  (mode-line-emphasis
   :weight bold)
  (mode-line-highlight
   :background @mode-line-hlt)
  (mode-line-inactive
   :inherit mode-line
   :background @bg
   :foreground @mode-line-inactive
   :box (:color @bg :line-width 3))

;; Syntax
  (error
   :inherit fixed-pitch)
  (font-lock-comment-face
   :foreground @muted
   :inherit fixed-pitch)
  (font-lock-builtin-face
   :foreground @builtin
   :inherit fixed-pitch)
  (font-lock-string-face
   :inherit fixed-pitch
   :foreground @string)
  (font-lock-function-name-face
   :inherit fixed-pitch
   :foreground @function-name)
  (font-lock-keyword-face
   :inherit fixed-pitch
   :foreground @keyword)
  (font-lock-comment-delimiter-face
   :inherit fixed-pitch
   :inherit font-lock-comment-face)
  (font-lock-constant-face
   :inherit fixed-pitch
   :foreground @constant)
  (font-lock-doc-face
   :inherit fixed-pitch
   :inherit font-lock-string-face)
  (font-lock-preprocessor-face
   :inherit fixed-pitch
   :inherit font-lock-builtin-face)
  (font-lock-regexp-grouping-backslash
   :inherit fixed-pitch
   :inherit bold)
  (font-lock-regexp-grouping-construct
   :inherit fixed-pitch
   :inherit bold)
  (font-lock-type-face
   :foreground @type
   :inherit fixed-pitch)
  (font-lock-variable-name-face
   :inherit fixed-pitch
   :foreground @variable)
  (font-lock-warning-face
   :inherit error)

;; Org
  ,@(generate-numbered-faces "org-level-" 1 8
     (lambda (index)
      `(:inherit default
        :foreground @header
        :height ,(header-height index))))
  (org-meta-line
   :inherit fixed-pitch
   :foreground @org-meta)
  (org-document-info-keyword
   :inherit fixed-pitch
   :foreground @org-document-info)
  (org-document-info
   :inherit default
   :foreground @org-document-info)
  (org-verbatim ; inline code
   :inherit fixed-pitch)
  (org-code
   :inherit fixed-pitch)
  (org-table
   :inherit fixed-pitch
   :background @org-table)
  (org-formula
   :inherit org-table
   :height *1)
  (org-verse
   :inherit default
   :foreground @org-quote-fg
   :background @org-quote-bg)
  (org-quote
   :inherit default
   :foreground @org-quote-fg
   :background @org-quote-bg)
  (org-hide
   :inherit fixed-pitch
   :foreground @bg)
  (org-indent
   :inherit org-hide)
  (org-date
   :inherit fixed-pitch
   :foreground @org-date
   :underline nil)
  (org-document-title
   :inherit default
   :foreground @org-title
   :height *1.8
   :underline (:color @org-title-underline))
  (org-checkbox
   :inherit fixed-pitch
   :weight bold
   :foreground @org-checkbox)
  (org-done
   :inherit fixed-pitch
   :foreground @org-done)
  (org-todo
   :inherit fixed-pitch
   :foreground @org-todo)
  (org-tag
   :inherit fixed-pitch
   :height *1
   :foreground @org-tag)
  (org-block-begin-line
   :inherit fixed-pitch
   :background @org-block-line)
  (org-block-end-line
   :inherit fixed-pitch
   :background @org-block-line)
  (org-block
   :background @org-block-bg
   :inherit fixed-pitch)
  (org-priority
   :inherit fixed-pitch
   :weight normal)
  (org-agenda-structure
   :foreground @org-agenda-structure-fg
   :background @bg
   :box (:line-width 3 :color @bg)
   :underline @org-agenda-structure-bg)
  (org-scheduled
   :foreground @org-scheduled)
  (org-scheduled-today
   :foreground @org-scheduled-today)
  (org-agenda-date-weekend
   :inherit org-agenda-structure)
  (org-agenda-date-today
   :box (:line-width 3 :color @org-agenda-today-bg)
   :foreground @org-agenda-today-fg
   :background @org-agenda-today-bg)
  (org-special-keyword
   :inherit fixed-pitch
   :foreground @org-special-keyword)
  (org-scheduled-previously
   :foreground @org-sched-prev)
  (org-agenda-done
   :foreground @org-agenda-done)
  (org-footnote
   :foreground @link)

;; hl-line
  (hl-line
   :background @hl-line)

;; linum / line numbers
  (linum-highlight-face
   :inherit fixed-pitch
   :foreground @linum-hlt)
  (linum
   :inherit fixed-pitch
   :foreground @linum)
  (line-number
   :inherit fixed-pitch
   :foreground @linum)
  (line-number-current-line
   :inherit fixed-pitch
   :foreground @linum-hlt)

;; Markdown
  ,@(generate-numbered-faces "markdown-header-face-" 1 8
     (lambda (index)
      `(:foreground @header
        :inherit default
        :height ,(header-height index))))
  (markdown-markup-face
   :inherit fixed-pitch
   :foreground @markdown-markup)
  (markdown-inline-code-face
   :inherit fixed-pitch)
  (markdown-metadata-key-face
   :inherit fixed-pitch
   :height *1
   :foreground @markdown-metadata)
  (markdown-metadata-value-face
   :inherit fixed-pitch
   :height *1
   :foreground @fg)
  (markdown-language-keyword-face
   :foreground @markdown-language)
  (markdown-list-face
   :inherit fixed-pitch
   :foreground @markdown-list)
  (markdown-code-face
   :inherit fixed-pitch
   :foreground @fg
   :background @markdown-code-bg)
  (markdown-pre-face
   :inherit fixed-pitch
   :color @fg
   :background @markdown-pre-bg)
  (markdown-header-delimiter-face
   :inherit fixed-pitch
   :foreground @markdown-header-delimiter)
  (markdown-header-rule-face
   :inherit fixed-pitch
   :foreground @markdown-header-delimiter)
  (markdown-url-face
   :inherit fixed-pitch
   :foreground @link)
;; imenu
  ,@(generate-numbered-faces
       "imenu-list-entry-face-" 0 5
       '(:foreground @imenu))
;; helm
  (helm-source-header
   :height *1))

Preface

;; Copyright 2018-now Kunal Bhalla

;; Author: Kunal Bhalla <bhalla.kunal@gmail.com>
;; URL: https://github.com/kunalb/poet/
;; Version: 2.0

;;; Commentary:

;; Emacs has very good support for multiple fonts in a single
;; file.  Poet uses this support to make it much more convenient to
;; write prose within Emacs, with particular attention paid to
;; org-mode and markdown-mode.  Code blocks, tables, etc are
;; formatted in monospace text with the appropriate backgrounds.

;; Recommended customizations for using this theme
;;
;; - Set up the base fonts you'd like to use in Emacs before loading Poet
;;     (set-face-attribute 'default nil :family "Iosevka" :height 130)
;;     (set-face-attribute 'fixed-pitch nil :family "Iosevka")
;;     (set-face-attribute 'variable-pitch nil :family "Baskerville")
;;   On loading this theme captures the default and treats that for fixed-pitch
;;   rendering.
;;
;; - Enable variable pitch mode for editing text
;; (add-hook 'text-mode-hook
;;            (lambda ()
;;             (variable-pitch-mode 1))
;;
;; - Some other modes I like to enable/disable
;;     (olivetti-mode 1)        ;; Centers text in the buffer
;;     (flyspell-mode 1)        ;; Catch Spelling mistakes
;;     (typo-mode 1)            ;; Good for symbols like em-dash
;;     (blink-cursor-mode 0)    ;; Reduce visual noise
;;     (linum-mode 0)           ;; No line numbers for prose
;;
;; - And prettier org mode bullets:
;;     (setq org-bullets-bullet-list
;;         '("◉" "○"))
;;     (org-bullets 1)

;;; Code:

(defvar poet--monospace-height
 (face-attribute 'fixed-pitch :height nil 'default)
 "The original height stored as a defvar to stay constant across reloads.")

(defun poet--height (multiplier)
 "Scale up the height according to the MULTIPLIER."
 (truncate (* poet--monospace-height multiplier)))

Theme Creator

(defun process (x)
  "Process the face list to replace color names with symbols,
   and heights with function values."
  (cond
   ((not x) '())
   ((listp x) (cons (process (car x)) (process (cdr x))))
   ((eq 'fixed-pitch-height x) "(lambda (base) base)")
   ((eq 'variable-pitch-family x) ",(face-attribute 'variable-pitch :family)") ; hack hack hack
   ((and (symbolp x) (string-prefix-p "@" (symbol-name x)))
    (concat "," (substring (symbol-name x) 1)))
   ((and (symbolp x) (string-prefix-p "*" (symbol-name x)))
    (concat "(lambda (base) (truncate (* (face-attribute 'fixed-pitch :height nil 'default) " (substring (symbol-name x) 1) ")))"))
   ((stringp x) (concat "\"" x "\""))
   (t x)))

(concat
 "(let ("
 (mapconcat
  (lambda (x)
    (concat "(" (car x) " \"" (cadr x) "\")"))
  (cdr palette)
  "\n      ")
 ")\n"
 " (custom-theme-set-faces '" theme-name "\n"
 (mapconcat
  (lambda (x)
    (format "  `(%s ((t %s)))"
            (car x)
            (cdr x)))
  (process structure)
  "\n")
 ")\n"
 " (custom-theme-set-variables '" theme-name "\n"
 "  '(line-spacing .2)\n"
 "  `(fci-rule-color ,fci)))")

Postface

;;;###autoload
(when (and (boundp 'custom-theme-load-path)
           load-file-name)
  (add-to-list 'custom-theme-load-path
               (file-name-as-directory
                (file-name-directory load-file-name))))

Themes

Poet

LabelColor
fg#444444
bg#e1d9c2
emph#222222
sep#eeeeee
hlt#efefef
bg-hlt#fff8e1
muted#795548
meta#4e342e
link#303f9f
link-underline#304ffe
vlink-underline#1a237e
header#770b0b
button#616161
glyph#673AB7
cursor#333333
paren-match-bg#ff1744
paren-match-fg#ffffff
search-fg#c2185b
search-bg#ffffff
search-fail-bg#f8bbd0
tooltip-fg#111111
tooltip-bg#fff176
shadow#999999
secondary-bg#fff59d
trailing-bg#ff8a65
fci#dedede
lazy-hlt-fg#000000
lazy-hlt-bg#ffffff
evil-rep-fg#ffffff
evil-rep-bg#4e342e
mode-line-fg#111111
header-line-bg#e0e0e0
mode-line-hlt#ffffff
mode-line-inactive#888888
builtin#795548
string#6C3082
function-name#388E3C
keyword#bf360c
constant#0288D1
type#3f51b5
variable#455A64
org-meta#8D6E63
org-document-info#795548
org-table#e0e0e0
org-quote-fg#4A148C
org-quote-bg#e0e0e0
org-date#444444
org-title#B71C1C
org-title-underline#aaaaaa
org-checkbox#aaaaaa
org-scheduled#333333
org-scheduled-today#111111
org-done#388E3C
org-todo#BF360C
org-tag#777777
org-block-line#c7c7c7
org-block-bg#e0e0e0
org-agenda-structure-fg#555555
org-agenda-structure-bg#e0e0e0
org-agenda-today-fg#000000
org-agenda-today-bg#eeeeee
org-special-keyword#777777
org-sched-prev#3f0000
org-agenda-done#777777
hl-line#efefef
linum-hlt#555555
linum#aaaaaa
markdown-markup#8D6E63
markdown-metadata#777777
markdown-language#7b1fa2
markdown-list#000000
markdown-code-bg#e0e0e0
markdown-pre-bg#e0e0e0
markdown-header-delimiter#8D6E63
imenu#4e342e
;;; poet-theme.el --- A theme for prose.

<<theme-preface>>
(deftheme poet
  "A prose friendly theme.")

<<theme-definition(palette=poet-palette, theme-name="poet")>>

<<theme-postface>>

(provide-theme 'poet)
;;; poet-theme.el ends here

Dark Poet

LabelColor
fg#EDE7dd
bg#181008
emph#eeeeee
sep#444444
hlt#000000
bg-hlt#012c32
muted#aaaaaa
meta#ede7dd
link#ffdba5
link-underline#ffdba5
vlink-underline#ffffff
header#ceb39e
button#aaaaaa
glyph#f7ffd1
cursor#FFD5BE
paren-match-bg#ff1744
paren-match-fg#ffffff
search-fg#ffffff
search-bg#fb6542
search-fail-bg#f8bbd0
tooltip-fg#111111
tooltip-bg#fff176
shadow#999999
secondary-bg#000000
trailing-bg#ff8a65
fci#dedede
lazy-hlt-fg#000000
lazy-hlt-bg#ffffff
evil-rep-fg#ffffff
evil-rep-bg#4e342e
mode-line-fg#edd3c4
header-line-bg#111111
mode-line-hlt#000000
mode-line-inactive#888888
builtin#b85750
string#dddddd
function-name#80bd9e
keyword#c1caa1
constant#90afc5
type#cfa6a8
variable#ffa575
org-meta#c6b6ad
org-document-info#c6b6ad
org-table#171716
org-quote-fg#e6e6fa
org-quote-bg#171716
org-date#c6b6ad
org-title#ee7e38
org-title-underline#ee7e38
org-checkbox#999999
org-scheduled#dddddd
org-scheduled-today#ffffff
org-done#5EE300
org-todo#FF3D00
org-tag#aaaaaa
org-block-line#070706
org-block-bg#171716
org-agenda-structure-fg#aaaaaa
org-agenda-structure-bg#111111
org-agenda-today-fg#dddddd
org-agenda-today-bg#000000
org-special-keyword#777777
org-sched-prev#ffb6c1
org-agenda-done#b9ccb2
hl-line#3d0000
linum-hlt#bbbbbb
linum#555555
markdown-markup#8D6E63
markdown-metadata#777777
markdown-language#BE8CD4
markdown-list#ffffff
markdown-code-bg#171716
markdown-pre-bg#171716
markdown-header-delimiter#8D6E63
imenu#ceb39e
;;; poet-dark-theme.el --- A dark theme for prose.

<<theme-preface>>
(deftheme poet-dark
  "A prose friendly dark theme.")

<<theme-definition(palette=poet-dark-palette, theme-name="poet-dark")>>

<<theme-postface>>

(provide-theme 'poet-dark)
;;; poet-dark-theme.el ends here

Monochrome Poet

(defun desaturate-color (color-hex)
  "Converts a color string to its desaturated equivalent hex string"
  (require 'color)
  (apply
   'color-rgb-to-hex
   (append (apply
            'color-hsl-to-rgb
            (apply
             'color-desaturate-hsl
             `(,@(apply 'color-rgb-to-hsl (color-name-to-rgb color-hex)) 100)))
           '(2))))
(cons
 (car base-palette)
 (mapcar
  (lambda (x)
   `(,(car x) ,(desaturate-color (cadr x))))
  (cdr base-palette)))
;;; poet-monochrome-theme.el --- A monochrome theme for prose.

<<theme-preface>>
(deftheme poet-monochrome
  "A monochrome prose friendly theme.")

<<theme-definition(palette=poet-monochrome-palette, theme-name="poet-monochrome")>>

<<theme-postface>>

(provide-theme 'poet-monochrome)
;;; poet-monochrome-theme.el ends here

Dark Monochrome Poet

(cons
 (car base-palette)
 (mapcar
  (lambda (x)
   `(,(car x) ,(desaturate-color (cadr x))))
  (cdr base-palette)))
;;; poet-dark-monochrome-theme.el --- A dark monochrome theme for prose.

<<theme-preface>>
(deftheme poet-dark-monochrome
  "A dark monochrome prose friendly theme.")

<<theme-definition(palette=poet-dark-monochrome-palette, theme-name="poet-dark-monochrome")>>

<<theme-postface>>

(provide-theme 'poet-dark-monochrome)
;;; poet-dark-monochrome-theme ends here

For simpler iteration

(defun poet-refresh-theme ()
  (interactive)
  (org-babel-tangle)
  (load-theme
    (car custom-enabled-themes)
    t))
(add-hook
   'after-save-hook
   'poet-refresh-theme
    nil
    t)