branch: elpa/telephone-line
commit 426a598c4abdbdc9cf702f383f6b9ea7c6d084c1
Author: Daniel Bordak <[email protected]>
Commit: Daniel Bordak <[email protected]>
Start work on memoize replacement
---
telephone-line-separators.el | 28 +++++++++-------
telephone-line-utils.el | 76 ++++++++++++++++++++++++++++++++++++--------
telephone-line.el | 18 +++++------
3 files changed, 88 insertions(+), 34 deletions(-)
diff --git a/telephone-line-separators.el b/telephone-line-separators.el
index ddada6b970..b786973c76 100644
--- a/telephone-line-separators.el
+++ b/telephone-line-separators.el
@@ -31,18 +31,22 @@
(/ num (float width)))
(number-sequence 1 width)))
-(telephone-line-defseparator telephone-line-abs-right
- #'abs #'telephone-line-row-pattern
- #xe0b2)
-(telephone-line-defseparator telephone-line-abs-left
- (telephone-line-complement abs) #'telephone-line-row-pattern
- #xe0b0)
-(telephone-line-defsubseparator telephone-line-abs-hollow-right
- #'abs #'telephone-line-row-pattern-hollow
- #xe0b3)
-(telephone-line-defsubseparator telephone-line-abs-hollow-left
- (telephone-line-complement abs) #'telephone-line-row-pattern-hollow
- #xe0b1)
+(defvar telephone-line-abs-right
+ (telephone-line-separator "abs-right"
+ :axis-func #'abs
+ :alt-char #xe0b2))
+(defvar telephone-line-abs-left
+ (telephone-line-separator "abs-left"
+ :axis-func (telephone-line-complement abs)
+ :alt-char #xe0b2))
+(defvar telephone-line-abs-hollow-right
+ (telephone-line-subseparator "abs-hollow-right"
+ :axis-func #'abs
+ :alt-char #xe0b2))
+(defvar telephone-line-abs-hollow-left
+ (telephone-line-subseparator "abs-hollow-left"
+ :axis-func (telephone-line-complement abs)
+ :alt-char #xe0b2))
(telephone-line-defseparator telephone-line-cubed-right
(lambda (x) (expt x 3)) #'telephone-line-row-pattern)
diff --git a/telephone-line-utils.el b/telephone-line-utils.el
index 9a2457f6dd..e57b51bdd7 100644
--- a/telephone-line-utils.el
+++ b/telephone-line-utils.el
@@ -21,6 +21,7 @@
(require 'cl-lib)
(require 'color)
+(require 'eieio)
(require 'memoize)
(require 's)
@@ -140,7 +141,7 @@ color1 and color2."
(cons (- 1 rem) ;Right AA pixel
(make-list (- total intpadding 2) 1)))))) ;Right gap
-(defun telephone-line-create-body (width height axis-func pattern-func)
+(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))))
@@ -175,17 +176,6 @@ color1 and color2."
:background bg-color
:inverse-video t))))))
-(defmacro telephone-line-defseparator (name axis-func pattern-func &optional
alt-char 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."
- (declare (indent defun))
- `(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))
- (char-to-string ,alt-char)))
-
(defun telephone-line--pad-body (body char-width)
"Pad 2d byte-list BODY to a width of CHAR-WIDTH, given as a number of
characters."
(let* ((body-width (length (car body)))
@@ -196,6 +186,17 @@ NOTE: Forced-width primary separators are not currently
supported."
(append left-padding row right-padding))
body)))
+(defmacro telephone-line-defseparator (name axis-func pattern-func &optional
alt-char 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."
+ (declare (indent defun))
+ `(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))
+ (char-to-string ,alt-char)))
+
(defmacro telephone-line-defsubseparator (name axis-func pattern-func
&optional alt-char forced-width)
"Define a subseparator named NAME, using AXIS-FUNC and PATTERN-FUNC to
create the shape, optionally forcing FORCED-WIDTH."
(declare (indent defun))
@@ -205,7 +206,7 @@ NOTE: Forced-width primary separators are not currently
supported."
(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)
+ (telephone-line--create-body width height ,axis-func ,pattern-func)
char-width))
(string ? ,alt-char ? )))
@@ -243,6 +244,55 @@ Return nil for blank/empty strings."
(replace-regexp-in-string "%" "%%" trimmed-str)
str))))
+(defclass telephone-line-separator ()
+ ((axis-func :initarg :axis-func)
+ (pattern-func :initarg :pattern-func :initform #'telephone-line-row-pattern)
+ (alt-char :initarg :alt-char)
+ (image-cache :initform (make-hash-table :test 'equal))))
+
+(defclass telephone-line-subseparator (telephone-line-separator)
+ ((pattern-func :initarg :pattern-func :initform
#'telephone-line-row-pattern-hollow)))
+
+(defmethod telephone-line-separator-create-body ((obj
telephone-line-separator) &optional forced-width)
+ (telephone-line--create-body (telephone-line-separator-width)
+ (telephone-line-separator-height)
+ (oref obj axis-func)
+ (oref obj pattern-func)))
+
+(defmethod telephone-line-separator-create-body ((obj
telephone-line-subseparator) &optional forced-width)
+ (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
+ (oref obj axis-func)
+ (oref obj pattern-func))
+ char-width)))
+
+(defmethod telephone-line-separator-render ((obj telephone-line-separator)
foreground background)
+ (let* ((bg-color (telephone-line--separator-arg-handler background))
+ (fg-color (telephone-line--separator-arg-handler foreground))
+ (hash-key (concat bg-color "_" fg-color)))
+ (if window-system
+ ;; Return cached image if we have it.
+ (or (gethash hash-key (oref obj image-cache))
+ (let ((height (telephone-line-separator-height))
+ (width (telephone-line-separator-width)))
+ (puthash hash-key
+ (telephone-line-propertize-image
+ (telephone-line--create-pbm-image
(telephone-line-separator-create-body obj)
+ bg-color fg-color))
+ (oref obj image-cache))))
+
+ (list :propertize (char-to-string (oref obj alt-char))
+ 'face (list :foreground fg-color
+ :background bg-color
+ :inverse-video t)))))
+
+(defmethod telephone-line-separator-clear-cache ((obj
telephone-line-separator))
+ (clrhash (oref obj image-cache)))
+
;;Stole this bit from seq.el
(defun telephone-line--activate-font-lock-keywords ()
"Activate font-lock keywords for some symbols defined in telephone-line."
diff --git a/telephone-line.el b/telephone-line.el
index 5ae382d32f..08de3cc5c8 100644
--- a/telephone-line.el
+++ b/telephone-line.el
@@ -82,33 +82,33 @@
:group 'telephone-line-evil)
(defface telephone-line-evil-operator
- '((t (:background "sky blue" :inherit telephone-line-evil)))
+ '((t (:background "violet" :inherit telephone-line-evil)))
"Face used in evil color-coded segments when in Operator state."
:group 'telephone-line-evil)
(defface telephone-line-evil-emacs
- '((t (:background "blue violet" :inherit telephone-line-evil)))
+ '((t (:background "dark violet" :inherit telephone-line-evil)))
"Face used in evil color-coded segments when in Emacs state."
:group 'telephone-line-evil)
-(defcustom telephone-line-primary-left-separator #'telephone-line-abs-left
+(defcustom telephone-line-primary-left-separator 'telephone-line-abs-left
"The primary separator to use on the left-hand side."
:group 'telephone-line
:type 'function)
-(defcustom telephone-line-primary-right-separator #'telephone-line-abs-right
+(defcustom telephone-line-primary-right-separator 'telephone-line-abs-right
"The primary separator to use on the right-hand side."
:group 'telephone-line
:type 'function)
-(defcustom telephone-line-secondary-left-separator
#'telephone-line-abs-hollow-left
+(defcustom telephone-line-secondary-left-separator
'telephone-line-abs-hollow-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 telephone-line-secondary-right-separator
#'telephone-line-abs-hollow-right
+(defcustom telephone-line-secondary-right-separator
'telephone-line-abs-hollow-right
"The secondary separator to use on the right-hand side.
Secondary separators do not incur a background color change."
@@ -177,7 +177,7 @@ Secondary separators do not incur a background color
change."
(cl-list*
cur-subsegments ;New segment
;; Separator
- `(:eval (funcall #',primary-sep
+ `(:eval (telephone-line-separator-render ,primary-sep
(telephone-line-face-map ',prev-color-sym)
(telephone-line-face-map ',cur-color-sym)))
accumulated-segments) ;Old segments
@@ -195,7 +195,7 @@ Secondary separators do not incur a background color
change."
(let* ((cur-face (telephone-line-face-map color-sym))
(opposite-face (telephone-line-face-map
(telephone-line-opposite-face-sym color-sym)))
- (subseparator (funcall sep-func cur-face opposite-face)))
+ (subseparator (telephone-line-separator-render sep-func cur-face
opposite-face)))
(telephone-line-propertize-segment
color-sym cur-face
(cdr (seq-mapcat
@@ -218,7 +218,7 @@ separators, as they are conditional, are evaluated
on-the-fly."
(cons color-sym
`(:eval
(telephone-line-add-subseparators
- ',subsegments #',secondary-sep ',color-sym)))))
+ ',subsegments ,secondary-sep ',color-sym)))))
(seq-reverse segments))
'(nil . nil))))
