[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/telephone-line 0d15e2882b 002/195: Add the fruits of my la
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/telephone-line 0d15e2882b 002/195: Add the fruits of my labor |
Date: |
Wed, 5 Jan 2022 02:59:15 -0500 (EST) |
branch: elpa/telephone-line
commit 0d15e2882b917b126c8fb045dae7c09b0c752aae
Author: Daniel Bordak <dbordak@fastmail.fm>
Commit: Daniel Bordak <dbordak@fastmail.fm>
Add the fruits of my labor
---
telephone-line-segments.el | 112 ++++++++++++++++
telephone-line-separators.el | 98 ++++++++++++++
telephone-line-utils.el | 229 +++++++++++++++++++++++++++++++++
telephone-line.el | 299 +++++++++++++++++++++++++++++++++++++++++++
4 files changed, 738 insertions(+)
diff --git a/telephone-line-segments.el b/telephone-line-segments.el
new file mode 100644
index 0000000000..3c22b576bf
--- /dev/null
+++ b/telephone-line-segments.el
@@ -0,0 +1,112 @@
+;;; telephone-line-segments.el --- Segments for Telephone Line
+
+;; Copyright (C) 2015 Daniel Bordak
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Segments for Telephone Line.
+;; To create your own, look at the functions defined in telephone-line-utils.el
+
+;;; Code:
+
+(require 'telephone-line-utils)
+
+:autoload
+(telephone-line-defsegment telephone-line-vc-segment
+ vc-mode)
+
+:autoload
+(telephone-line-defsegment telephone-line-process-segment
+ mode-line-process)
+
+:autoload
+(telephone-line-defsegment telephone-line-position-segment
+ (if (eq major-mode 'paradox-menu-mode)
+ mode-line-front-space ;Paradox fills this with position info.
+ mode-line-position))
+
+:autoload
+(telephone-line-defsegment telephone-line-airline-position-segment
+ (if (eq major-mode 'paradox-menu-mode)
+ mode-line-front-space
+ '((-3 "%p") " %4l:%3c")))
+
+:autoload
+(telephone-line-defsegment telephone-line-misc-info-segment
+ mode-line-misc-info)
+
+:autoload
+(telephone-line-defsegment* telephone-line-buffer-segment
+ `(""
+ mode-line-mule-info
+ mode-line-modified
+ mode-line-client
+ mode-line-remote
+ mode-line-frame-identification
+ ,(telephone-line-raw mode-line-buffer-identification t)))
+
+:autoload
+(telephone-line-defsegment-plist telephone-line-major-mode-segment
+ (let ((recursive-edit-help-echo "Recursive edit, type C-M-c to get out"))
+ `((:propertize "%[" help-echo ,recursive-edit-help-echo)
+ (:propertize ("" mode-name)
+ help-echo "Major mode\n\
+mouse-1: Display major mode menu\n\
+mouse-2: Show help for major mode\n\
+mouse-3: Toggle minor modes"
+ mouse-face mode-line-highlight
+ local-map ,mode-line-major-mode-keymap)
+ (:propertize "%]" help-echo ,recursive-edit-help-echo))))
+
+:autoload
+(telephone-line-defsegment-plist telephone-line-minor-mode-segment
+ `((:propertize ("" minor-mode-alist)
+ mouse-face mode-line-highlight
+ help-echo "Minor mode\n\
+mouse-1: Display minor mode menu\n\
+mouse-2: Show help for minor mode\n\
+mouse-3: Toggle minor modes"
+ local-map ,mode-line-minor-mode-keymap)
+ (:propertize "%n"
+ mouse-face mode-line-highlight
+ help-echo "mouse-2: Remove narrowing from buffer"
+ local-map ,(make-mode-line-mouse-map
+ 'mouse-2 #'mode-line-widen))))
+
+:autoload
+(telephone-line-defsegment* telephone-line-erc-modified-channels-segment
+ (s-with erc-modified-channels-object
+ s-trim (s-chop-suffix "]") (s-chop-prefix "[")))
+
+(eval-after-load 'evil
+ '(telephone-line-defsegment* telephone-line-evil-tag-segment
+ (let ((tag
+ (if (evil-visual-state-p)
+ (cond
+ ((eq evil-visual-selection 'block)
+ (if telephone-line-evil-use-short-tag "VB"
+ "V-BLOCK"))
+ ((eq evil-visual-selection 'line)
+ (if telephone-line-evil-use-short-tag "VL"
+ "V-LINE"))
+ (t "VISUAL"))
+ (upcase (symbol-name evil-state)))))
+ (if telephone-line-evil-use-short-tag
+ (s-left 2 tag)
+ tag))))
+
+(provide 'telephone-line-segments)
+;;; telephone-line-segments.el ends here
diff --git a/telephone-line-separators.el b/telephone-line-separators.el
new file mode 100644
index 0000000000..f2c2cb3886
--- /dev/null
+++ b/telephone-line-separators.el
@@ -0,0 +1,98 @@
+;;; telephone-line-separators.el --- Separators for Telephone Line
+
+;; Copyright (C) 2015 Daniel Bordak
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Separators for Telephone Line.
+;; To create your own, look at the functions defined in telephone-line-utils.el
+;; TODO: Trig separators
+
+;;; Code:
+
+(require 'memoize)
+(require 'color)
+(require 'telephone-line-utils)
+
+(defcustom telephone-line-utf-8-primary-left-separator #xe0b0
+ "The unicode codepoint for the left facing primary separator."
+ :group 'telephone-line
+ :type '(choice integer (const nil)))
+
+(defcustom telephone-line-utf-8-secondary-left-separator #xe0b1
+ "The unicode codepoint for the left facing secondary separator."
+ :group 'telephone-line
+ :type '(choice integer (const nil)))
+
+(defcustom telephone-line-utf-8-primary-right-separator #xe0b2
+ "The unicode codepoint for the right facing primary separator."
+ :group 'telephone-line
+ :type '(choice integer (const nil)))
+
+(defcustom telephone-line-utf-8-secondary-right-separator #xe0b3
+ "The unicode codepoint for the right facing secondary separator."
+ :group 'telephone-line
+ :type '(choice integer (const nil)))
+
+(defun telephone-line-row-pattern-fixed-gradient (_ width)
+ "Create a gradient bytestring of WIDTH from FG-COLOR to BG-COLOR."
+ (mapcar (lambda (num)
+ (/ num (float width)))
+ (number-sequence 1 width)))
+
+(telephone-line-defseparator telephone-line-abs-right
+ #'abs #'telephone-line-row-pattern)
+(telephone-line-defseparator telephone-line-abs-left
+ (telephone-line-negate-func abs) #'telephone-line-row-pattern)
+(telephone-line-defsubseparator telephone-line-abs-hollow-right
+ #'abs #'telephone-line-row-pattern-hollow)
+(telephone-line-defsubseparator telephone-line-abs-hollow-left
+ (telephone-line-negate-func abs) #'telephone-line-row-pattern-hollow)
+(telephone-line-defseparator telephone-line-cubed-right
+ (lambda (x) (expt x 3)) #'telephone-line-row-pattern)
+(telephone-line-defseparator telephone-line-cubed-left
+ (lambda (x) (- (expt x 3))) #'telephone-line-row-pattern)
+(telephone-line-defseparator telephone-line-cubed-hollow-right
+ (lambda (x) (expt x 3)) #'telephone-line-row-pattern-hollow)
+(telephone-line-defseparator telephone-line-cubed-hollow-left
+ (lambda (x) (- (expt x 3))) #'telephone-line-row-pattern-hollow)
+(telephone-line-defseparator telephone-line-gradient
+ #'identity #'telephone-line-row-pattern-fixed-gradient)
+(telephone-line-defseparator telephone-line-identity-right
+ #'identity #'telephone-line-row-pattern)
+(telephone-line-defseparator telephone-line-identity-left
+ #'- #'telephone-line-row-pattern)
+(defmemoize telephone-line-nil (color1 color2)
+ nil)
+
+(defmemoize telephone-line-utf-8-filled-left (foreground background)
+ (propertize (char-to-string telephone-line-utf-8-primary-left-separator)
+ 'face `(:foreground ,foreground :background ,background)))
+
+(defmemoize telephone-line-utf-8-filled-right (background foreground) ;Note
the reversed params
+ (propertize (char-to-string telephone-line-utf-8-primary-right-separator)
+ 'face `(:foreground ,foreground :background ,background)))
+
+(defmemoize telephone-line-utf-8-left (foreground background)
+ (propertize (concat " " (char-to-string
telephone-line-utf-8-secondary-left-separator) " ")
+ 'face `(:foreground ,foreground :background ,background)))
+
+(defmemoize telephone-line-utf-8-right (foreground background)
+ (propertize (concat " " (char-to-string
telephone-line-utf-8-secondary-right-separator) " ")
+ 'face `(:foreground ,foreground :background ,background)))
+
+(provide 'telephone-line-separators)
+;;; telephone-line-separators.el ends here
diff --git a/telephone-line-utils.el b/telephone-line-utils.el
new file mode 100644
index 0000000000..17a8cc874f
--- /dev/null
+++ b/telephone-line-utils.el
@@ -0,0 +1,229 @@
+;;; telephone-line-utils.el --- Functions for defining segparators and segments
+
+;; Copyright (C) 2015 Daniel Bordak
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'memoize)
+(require 'cl-lib)
+(require 'seq)
+(require 'color)
+
+(defcustom telephone-line-height nil
+ "Override the mode-line height."
+ :group 'telephone-line
+ :type '(choice integer (const nil)))
+
+(defcustom telephone-line-separator-extra-padding 1
+ "Extra spacing around separators."
+ :group 'telephone-line
+ :type '(choice integer))
+
+(defcustom telephone-line-evil-use-short-tag nil
+ "If non-nil, use an abbreviated name for the evil mode tag."
+ :type 'boolean
+ :group 'telephone-line-evil)
+
+(defun telephone-line-separator-height ()
+ "Get the height for a telephone-line separator."
+ (or telephone-line-height (frame-char-height)))
+
+(defun telephone-line-separator-width ()
+ "Get the default width for a telephone-line separator."
+ (ceiling (telephone-line-separator-height) 2))
+
+(defun telephone-line-create-axis (length)
+ "Create an axis of length LENGTH."
+ (let ((middle (1- (ceiling length 2))))
+ (append (number-sequence (- middle) 0)
+ (number-sequence (if (cl-oddp length) 1 0) middle))))
+
+(defun telephone-line-normalize-axis (seq)
+ "Apply an offset to all values of SEQ such that its range begins at 0."
+ (let ((minimum (seq-min seq)))
+ (if (not (eq minimum 0))
+ (mapcar (lambda (i) (- i minimum)) seq)
+ seq)))
+
+(defun telephone-line-interpolate-rgb (color1 color2 &optional ratio)
+ "Interpolate between COLOR1 and COLOR2, with color1/color2 RATIO.
+When no RATIO is provided, produces the color halfway between
+color1 and color2."
+ (unless ratio (setq ratio .5))
+ (apply #'color-rgb-to-hex
+ (mapcar (lambda (n)
+ (+ (* ratio (nth n (color-name-to-rgb color1)))
+ (* (- 1 ratio) (nth n (color-name-to-rgb color2)))))
+ '(0 1 2))))
+
+(defun telephone-line-color-to-bytestring (color)
+ "Return an RGB bytestring for a given COLOR."
+ (seq-mapcat (lambda (subc)
+ (byte-to-string (floor (* 255 subc))))
+ (if (listp color)
+ color
+ (color-name-to-rgb color))
+ 'string))
+
+;; TODO: error on non-rectangular input?
+(defun telephone-line--create-pbm-image (body fg-color bg-color)
+ (create-image
+ (concat
+ (format "P6 %d %d 255 " (length (car body)) (length body))
+ (seq-mapcat (lambda (pixel)
+ (telephone-line-color-to-bytestring
+ (telephone-line-interpolate-rgb bg-color fg-color pixel)))
+ (seq-mapcat #'identity body)
+ 'string))
+ 'pbm t
+ :ascent 'center))
+
+(defun telephone-line-propertize-image (image)
+ "Return a propertized string of IMAGE."
+ (propertize (make-string (ceiling (car (image-size image))) ? )
+ 'display image))
+
+(defun telephone-line-row-pattern (fill total)
+ "Make a PBM line that has FILL FG-COLOR bytes out of TOTAL BG-COLOR bytes."
+ (seq-let (intfill rem) (floor* fill)
+ (nconc
+ (make-list intfill 0) ;Left fill
+ (when (< intfill total)
+ (list* (- 1 rem) ;AA pixel
+ (make-list (- total intfill 1) 1)))))) ;Right gap
+
+(defun telephone-line-row-pattern-hollow (padding total)
+ (seq-let (intpadding rem) (floor* padding)
+ (nconc
+ (make-list intpadding 1) ;Left gap
+ (when (< intpadding total)
+ (list rem)) ;Left AA pixel
+ (when (< (1+ intpadding) total)
+ (list*
+ (- 1 rem) ;Right AA pixel
+ (make-list (- total intpadding 2) 1)))))) ;Right gap
+
+(defun telephone-line-create-body (width height axis-func pattern-func)
+ "Create a bytestring of a PBM image body of dimensions WIDTH and HEIGHT, and
shape created from AXIS-FUNC and PATTERN-FUNC."
+ (let* ((normalized-axis (telephone-line-normalize-axis
+ (mapcar axis-func (telephone-line-create-axis
height))))
+ (range (1+ (seq-max normalized-axis)))
+ (scaling-factor (/ width (float range))))
+ (mapcar (lambda (x)
+ (funcall pattern-func
+ (* x scaling-factor) width))
+ normalized-axis)))
+
+(defmacro telephone-line-negate-func (func)
+ `(lambda (x)
+ (- (,func x))))
+
+(defun telephone-line--separator-arg-handler (arg)
+ (if (facep arg)
+ (face-attribute arg :background)
+ arg))
+
+(defmacro telephone-line--defseparator-internal (name body)
+ (declare (indent defun))
+ `(defmemoize ,name (foreground background)
+ (when window-system
+ (telephone-line-propertize-image
+ (telephone-line--create-pbm-image
+ ,body
+ (telephone-line--separator-arg-handler background)
+ (telephone-line--separator-arg-handler foreground))))))
+
+(defmacro telephone-line-defseparator (name axis-func pattern-func &optional
forced-width)
+ "Define a separator named NAME, using AXIS-FUNC and PATTERN-FUNC to create
the shape, optionally forcing FORCED-WIDTH.
+
+NOTE: Forced-width primary separators are not currently supported."
+ `(telephone-line--defseparator-internal ,name
+ (let ((height (telephone-line-separator-height))
+ (width (or ,forced-width (telephone-line-separator-width))))
+ (telephone-line-create-body width height ,axis-func ,pattern-func))))
+
+(defmacro telephone-line-defsubseparator (name axis-func pattern-func
&optional forced-width)
+ "Define a subseparator named NAME, using AXIS-FUNC and PATTERN-FUNC to
create the shape, optionally forcing FORCED-WIDTH."
+ `(telephone-line--defseparator-internal ,name
+ (let* ((height (telephone-line-separator-height))
+ (width (or ,forced-width (telephone-line-separator-width)))
+ (char-width (+ (ceiling width (frame-char-width))
+ telephone-line-separator-extra-padding)))
+ (telephone-line-pad-body
+ (telephone-line-create-body width height ,axis-func ,pattern-func)
+ char-width))))
+
+(defun telephone-line-pad-body (body char-width)
+ (let* ((body-width (length (car body)))
+ (padding-width (- (* char-width (frame-char-width)) body-width))
+ (left-padding (make-list (floor padding-width 2) 1))
+ (right-padding (make-list (ceiling padding-width 2) 1)))
+ (mapcar (lambda (row)
+ (append left-padding row right-padding))
+ body)))
+
+:autoload
+(defmacro telephone-line-defsegment (name body)
+ "Create function NAME by wrapping BODY with telephone-line padding and
propertization."
+ (declare (indent defun))
+ `(defun ,name (face)
+ (telephone-line-raw ,body face)))
+
+:autoload
+(defmacro telephone-line-defsegment* (name body)
+ "Create function NAME by wrapping BODY with telephone-line padding and
propertization.
+Segment is not precompiled."
+ (declare (indent defun))
+ `(defun ,name (face)
+ (telephone-line-raw ,body)))
+
+:autoload
+(defmacro telephone-line-defsegment-plist (name plists)
+ (declare (indent defun))
+ `(defun ,name (face)
+ (telephone-line-raw
+ (mapcar (lambda (plist)
+ (plist-put plist 'face face))
+ ,plists))))
+
+:autoload
+(defun telephone-line-raw (str &optional compiled)
+ "Conditionally render STR as mode-line data, or just verify output if not
COMPILED.
+Return nil for blank/empty strings."
+ (let ((trimmed-str (s-trim (format-mode-line str))))
+ (unless (s-blank? trimmed-str)
+ (if compiled
+ (replace-regexp-in-string "%" "%%" trimmed-str)
+ str))))
+
+;;Stole this bit from seq.el
+(defun telephone-line--activate-font-lock-keywords ()
+ "Activate font-lock keywords for some symbols defined in telephone-line."
+ (font-lock-add-keywords 'emacs-lisp-mode
+ '("\\<telephone-line-defsegment*\\>"
+ "\\<telephone-line-defsegment\\>"
+ "\\<telephone-line-defseparator\\>"
+ "\\<telephone-line-defsubseparator\\>")))
+
+(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
+ ;; In Emacsā„25, (via elisp--font-lock-flush-elisp-buffers and a few others)
+ ;; we automatically highlight macros.
+ (add-hook 'emacs-lisp-mode-hook
#'telephone-line--activate-font-lock-keywords))
+
+(provide 'telephone-line-utils)
+;;; telephone-line-utils.el ends here
diff --git a/telephone-line.el b/telephone-line.el
new file mode 100644
index 0000000000..bcc8f5defe
--- /dev/null
+++ b/telephone-line.el
@@ -0,0 +1,299 @@
+;;; telephone-line.el --- Rewrite of Powerline
+
+;; Copyright (C) 2015 Daniel Bordak
+
+;; Author: Daniel Bordak <dbordak@fastmail.fm>
+;; URL:
+;; Version: 0.1
+;; Keywords: mode-line
+;; Package-Requires: ((cl-lib "0.2") (memoize "1.0.1") (names "0.5") (s
"1.9.0") (seq "1.3"))
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Telephone Line is a library for customizing the mode-line that is
+;; based on the Vim Powerline. Themes can be created by customizing
+;; the telephone-line-lhs and telephone-line-rhs variables.
+;;
+
+;;; Code:
+
+(require 'telephone-line-separators)
+(require 'telephone-line-segments)
+
+(require 'seq)
+(require 's)
+
+;;;###autoload
+(define-namespace telephone-line-
+
+(defface accent-active
+ '((t (:background "grey22" :inherit mode-line)))
+ "Accent face for mode-line."
+ :group 'telephone-line)
+
+(defface accent-inactive
+ '((t (:background "grey11" :inherit mode-line-inactive)))
+ "Accent face for inactive mode-line."
+ :group 'telephone-line)
+
+(defface evil-insert
+ '((((class color))
+ :background "green" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil insert state"
+ :group 'telephone-line-evil)
+
+(defface evil-normal
+ '((((class color))
+ :background "red" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil normal state"
+ :group 'telephone-line-evil)
+
+(defface evil-visual
+ '((((class color))
+ :background "orange" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil visual state"
+ :group 'telephone-line-evil)
+
+(defface evil-motion
+ '((((class color))
+ :background "blue" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil motion state"
+ :group 'telephone-line-evil)
+
+(defface evil-emacs
+ '((((class color))
+ :background "blue violet" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil emacs state"
+ :group 'telephone-line-evil)
+
+(defface evil-replace
+ '((((class color))
+ :background "black" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil replace state"
+ :group 'telephone-line-evil)
+
+(defface evil-operator
+ '((((class color))
+ :background "sky blue" :weight bold :inherit mode-line)
+ (t (:weight bold)))
+ "face to fontify evil replace state"
+ :group 'telephone-line-evil)
+
+(defcustom primary-left-separator (if (window-system)
+ #'telephone-line-abs-left
+ #'telephone-line-utf-8-filled-left)
+ "The primary separator to use on the left-hand side."
+ :group 'telephone-line
+ :type 'function)
+
+(defcustom primary-right-separator (if (window-system)
+ #'telephone-line-abs-right
+ #'telephone-line-utf-8-filled-right)
+ "The primary separator to use on the right-hand side."
+ :group 'telephone-line
+ :type 'function)
+
+(defcustom secondary-left-separator (if (window-system)
+ #'telephone-line-abs-hollow-left
+ #'telephone-line-utf-8-left)
+ "The secondary separator to use on the left-hand side.
+
+Secondary separators do not incur a background color change."
+ :group 'telephone-line
+ :type 'function)
+
+(defcustom secondary-right-separator (if (window-system)
+ #'telephone-line-abs-hollow-right
+ #'telephone-line-utf-8-right)
+ "The secondary separator to use on the right-hand side.
+
+Secondary separators do not incur a background color change."
+ :group 'telephone-line
+ :type 'function)
+
+:autoload
+(defun fill (reserve &optional face)
+ "Return RESERVE empty space on the right, optionally with a FACE." ;;TODO:
Add face
+ (propertize " "
+ 'display `((space :align-to (- (+ right right-fringe
right-margin)
+ ,reserve)))))
+
+(defun -set-selected-window ()
+ (when (not (minibuffer-window-active-p (frame-selected-window)))
+ (setq selected-window (frame-selected-window))))
+
+(add-hook 'window-configuration-change-hook #'-set-selected-window)
+(defadvice select-window (after select-window activate)
+ (-set-selected-window))
+
+:autoload
+(defun selected-window-active ()
+ "Return whether the current window is active."
+ (and (boundp 'selected-window)
+ (eq selected-window (selected-window))))
+
+(defun face-map (sym)
+ "Return the face corresponding to SYM for the selected window's active
state."
+ (-face-map sym (selected-window-active)))
+
+;;TODO: Custom alist
+(defun -face-map (sym active)
+ "Return the face corresponding to SYM for the given ACTIVE state."
+ (cond ((eq sym 'evil) (evil-face active))
+ ((eq sym 'accent) (if active 'telephone-line-accent-active
+ 'telephone-line-accent-inactive))
+ (active 'mode-line)
+ (t 'mode-line-inactive)))
+
+;;TODO: Custom alist
+(defun opposite-face-sym (sym)
+ "Return the 'opposite' of the given SYM."
+ (cdr (assoc
+ sym '((evil . nil)
+ (accent . nil)
+ (nil . accent)))))
+
+(defun evil-face (active)
+ "Return an appropriate face for the current evil mode, given whether the
frame is ACTIVE."
+ (cond ((not active) 'mode-line-inactive)
+ ((not (boundp 'evil-state)) 'mode-line)
+ (t (intern (concat "telephone-line-evil-" (symbol-name evil-state))))))
+
+;;TODO: Clean this up
+(defun -separator-generator (primary-sep)
+ (lambda (acc e)
+ (let ((cur-color-sym (car e))
+ (prev-color-sym (cdr acc))
+ (cur-subsegments (cdr e))
+ (accumulated-segments (car acc)))
+
+ (cons
+ (if accumulated-segments
+ (list*
+ cur-subsegments ;New segment
+ ;; Separator
+ `(:eval (funcall #',primary-sep
+ (telephone-line-face-map ',prev-color-sym)
+ (telephone-line-face-map ',cur-color-sym)))
+ accumulated-segments) ;Old segments
+ (list cur-subsegments))
+ cur-color-sym))))
+
+(defun propertize-segment (pred face segment)
+ (unless (s-blank? (s-trim (format-mode-line segment)))
+ (if pred
+ `(:propertize (" " ,segment " ") face ,face)
+ `(" " ,segment " "))))
+
+;;TODO: Clean this up
+(defun add-subseparators (subsegments sep-func color-sym)
+ (let* ((cur-face (face-map color-sym))
+ (opposite-face (face-map (opposite-face-sym color-sym)))
+ (subseparator (funcall sep-func cur-face opposite-face)))
+ (propertize-segment
+ color-sym cur-face
+ (cdr (seq-mapcat
+ (lambda (subseg)
+ (when subseg
+ (list subseparator subseg)))
+ (mapcar (lambda (f) (funcall f cur-face))
+ subsegments))))))
+
+;;TODO: Clean this up
+(defun add-separators (segments primary-sep secondary-sep)
+ "Interpolates SEGMENTS with PRIMARY-SEP and SECONDARY-SEP.
+
+Primary separators are added at initialization. Secondary
+separators, as they are conditional, are evaluated on-the-fly."
+ (car (seq-reduce
+ (-separator-generator primary-sep)
+ (mapcar (lambda (segment-pair)
+ (seq-let (color-sym &rest subsegments) segment-pair
+ (cons color-sym
+ `(:eval
+ (telephone-line-add-subseparators
+ ',subsegments #',secondary-sep ',color-sym)))))
+ segments)
+ '(nil . nil))))
+
+(defun width (values num-separators)
+ "Get the column-length of VALUES, with NUM-SEPARATORS interposed."
+ (let ((base-width (string-width (format-mode-line values)))
+ (separator-width (/ (telephone-line-separator-width)
+ (float (frame-char-width)))))
+ (if window-system
+ (+ base-width
+ (* num-separators (- separator-width (ceiling separator-width))))
+ base-width)))
+
+(defcustom lhs '((accent . (telephone-line-vc-segment))
+ (nil . (telephone-line-minor-mode-segment
+ telephone-line-buffer-segment)))
+ "Left hand side segment alist."
+ :type '(alist :key-type segment-color :value-type subsegment-list)
+ :group 'telephone-line)
+
+(defcustom rhs '((accent . (telephone-line-position-segment))
+ (nil . (misc-info-segment
+ telephone-line-major-mode-segment)))
+ "Right hand side segment alist."
+ :type '(alist :key-type segment-color :value-type subsegment-list)
+ :group 'telephone-line)
+
+(defun -generate-mode-line-lhs ()
+ (add-separators
+ (seq-reverse lhs)
+ telephone-line-primary-left-separator
+ telephone-line-secondary-left-separator))
+
+(defun -generate-mode-line-rhs ()
+ (add-separators
+ rhs
+ telephone-line-primary-right-separator
+ telephone-line-secondary-right-separator))
+
+(defun -generate-mode-line ()
+ `(,@(telephone-line--generate-mode-line-lhs)
+ (:eval (telephone-line-fill
+ (telephone-line-width
+ ',(telephone-line--generate-mode-line-rhs)
+ ,(- (length telephone-line-rhs) 1))))
+ ,@(telephone-line--generate-mode-line-rhs)))
+
+(defvar -default-mode-line mode-line-format)
+
+:autoload
+(defun disable ()
+ "Revert to the default Emacs mode-line."
+ (interactive)
+ (setq-default mode-line-format -default-mode-line))
+
+:autoload
+(defun enable ()
+ "Setup the default mode-line."
+ (interactive)
+ (setq-default mode-line-format `("%e"
,@(telephone-line--generate-mode-line))))
+
+) ; End of namespace
+
+(provide 'telephone-line)
+;;; telephone-line.el ends here
- [nongnu] elpa/telephone-line 2906d39401 116/195: Oops, don't want accidental rounding., (continued)
- [nongnu] elpa/telephone-line 2906d39401 116/195: Oops, don't want accidental rounding., ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 909c1779e4 089/195: Fixed rainbow face examples, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line aa2c6840c9 107/195: Add separator gallery, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 09ff89a090 110/195: Add alias for modal colorsym, rename tl-evil-face to tl-modal-face, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 541c7d80d9 103/195: Corrected axis algorithm, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 0715ee7d15 064/195: Fix Readme formatting, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 5c47442844 083/195: Update readme + screenshots, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 30225c9778 069/195: Fix Emacs 25, oops, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 8b3c9499bf 051/195: Oops, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 5766b1b21f 033/195: Merge pull request #11 from ryanprior/patch-1, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 0d15e2882b 002/195: Add the fruits of my labor,
ELPA Syncer <=
- [nongnu] elpa/telephone-line 09997c1aee 006/195: Cleanup, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 06887f2440 001/195: Initial commit, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 5919a8e296 003/195: Fix package info, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 303cc3a1cd 010/195: Use cl-lib function instead of cl.el, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line d18709b144 044/195: Add Melpa Stable badge, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line f5e6663883 037/195: Much more Readme content, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 32245b5e30 072/195: Update copyright, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 3ad335a4c4 028/195: Correct default rhs value, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line 7feb552dcf 048/195: Remove names, ELPA Syncer, 2022/01/05
- [nongnu] elpa/telephone-line a2e2b5652f 013/195: Add emacs version requirement, ELPA Syncer, 2022/01/05