emacs-elpa-diffs
[Top][All Lists]
Advanced

[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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]