[nongnu] elpa/telephone-line d80e1bd857 119/195: Radically redo segment definitions

[ELPA Syncer]

branch: elpa/telephone-line
commit d80e1bd8577c6278637e5afac40c45fe28921d8b
Author: Daniel Bordak <dbordak@fastmail.fm>
Commit: Daniel Bordak <dbordak@fastmail.fm>

    Radically redo segment definitions
---
 telephone-line-segments.el | 80 ++++++++++++++++++++++------------------------
 telephone-line-utils.el    | 42 ++++++++++++++----------
 telephone-line.el          |  2 +-
 3 files changed, 66 insertions(+), 58 deletions(-)

diff --git a/telephone-line-segments.el b/telephone-line-segments.el
index d40c353593..c8569b095d 100644
--- a/telephone-line-segments.el
+++ b/telephone-line-segments.el
@@ -1,4 +1,4 @@
-;;; telephone-line-segments.el --- Segments for Telephone Line
+;;; telephone-line-segments.el --- Segments for Telephone Line -*- 
lexical-binding: t -*-
 
 ;; Copyright (C) 2015-2017 Daniel Bordak
 
@@ -24,30 +24,30 @@
 
 (require 'telephone-line-utils)
 
-(telephone-line-defsegment telephone-line-vc-segment ()
-  vc-mode
-  :preformatted t)
+(telephone-line-defsegment* telephone-line-vc-segment ()
+  (telephone-line-raw vc-mode t))
 
 (telephone-line-defsegment telephone-line-process-segment ()
   mode-line-process)
 
-(telephone-line-defsegment telephone-line-position-segment ()
-  (if (eq major-mode 'paradox-menu-mode)
-      ;;Paradox fills this with position info.
-      (string-trim (format-mode-line mode-line-front-space))
-    mode-line-position)
-  :preformatted t)
+(telephone-line-defsegment* telephone-line-position-segment ()
+  (telephone-line-raw
+   (if (eq major-mode 'paradox-menu-mode)
+       ;;Paradox fills this with position info.
+       mode-line-front-space
+     mode-line-position) t))
 
-(telephone-line-defsegment telephone-line-airline-position-segment ()
-  (if (eq major-mode 'paradox-menu-mode)
-      (string-trim (format-mode-line mode-line-front-space))
-    '((-3 "%p") " %4l:%3c")))
+(telephone-line-defsegment* telephone-line-airline-position-segment (&optional 
lines columns)
+  (let* ((l (number-to-string (if lines lines 4)))
+         (c (number-to-string (if columns columns 3))))
+    (if (eq major-mode 'paradox-menu-mode)
+        (telephone-line-raw mode-line-front-space t)
+      `((-3 "%p") ,(concat " %" l "l:%" c "c")))))
 
-(telephone-line-defsegment telephone-line-misc-info-segment ()
-  mode-line-misc-info
-  :preformatted t)
+(telephone-line-defsegment* telephone-line-misc-info-segment ()
+  (telephone-line-raw mode-line-misc-info t))
 
-(telephone-line-defsegment telephone-line-buffer-segment ()
+(telephone-line-defsegment* telephone-line-buffer-segment ()
   `(""
     mode-line-mule-info
     mode-line-modified
@@ -56,51 +56,50 @@
     mode-line-frame-identification
     ,(telephone-line-raw mode-line-buffer-identification t)))
 
-(telephone-line-defsegment telephone-line-simple-major-mode-segment ()
-  "%[%m%]"
-  :preformatted t)
+(telephone-line-defsegment* telephone-line-simple-major-mode-segment ()
+  "%[%m%]")
 
-(telephone-line-defsegment telephone-line-simple-minor-mode-segment ()
-  minor-mode-alist
-  :preformatted t)
+(telephone-line-defsegment* telephone-line-simple-minor-mode-segment ()
+  (telephone-line-raw minor-mode-alist t))
 
 (telephone-line-defsegment telephone-line-narrow-segment ()
-  "%n"
-  :preformatted t)
+  "%n")
 
-(telephone-line--defsegment-plist telephone-line-major-mode-segment ()
+(telephone-line-defsegment* 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 "%[" help-echo ,recursive-edit-help-echo face ,face)
       (: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))))
+                   local-map ,mode-line-major-mode-keymap
+                   face ,face)
+      (:propertize "%]" help-echo ,recursive-edit-help-echo face ,face))))
 
-(telephone-line--defsegment-plist telephone-line-minor-mode-segment ()
+(telephone-line-defsegment 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)
+                 local-map ,mode-line-minor-mode-keymap
+                 face ,face)
     (: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))))
+                             'mouse-2 #'mode-line-widen)
+                 face ,face)))
 
 (telephone-line-defsegment telephone-line-erc-modified-channels-segment ()
   (when (boundp 'erc-modified-channels-object)
-    (string-trim erc-modified-channels-object))
-  :preformatted t)
+    (string-trim erc-modified-channels-object)))
 
 (eval-after-load 'evil
-  '(telephone-line-defsegment telephone-line-evil-tag-segment ()
+  '(telephone-line-defsegment* telephone-line-evil-tag-segment ()
      (let ((tag (cond
                  ((not (evil-visual-state-p)) (upcase (symbol-name 
evil-state)))
                  ((eq evil-visual-selection 'block)
@@ -113,7 +112,7 @@ mouse-3: Toggle minor modes"
          tag))))
 
 (eval-after-load 'xah-fly-keys
-  '(telephone-line-defsegment telephone-line-xah-fly-keys-segment ()
+  '(telephone-line-defsegment* telephone-line-xah-fly-keys-segment ()
      (let ((tag (if xah-fly-insert-state-q
                     "INSERT" "COMMAND")))
        (if telephone-line-evil-use-short-tag
@@ -121,7 +120,7 @@ mouse-3: Toggle minor modes"
          tag))))
 
 (eval-after-load 'ryo-modal
-  '(telephone-line-defsegment telephone-line-ryo-modal-segment ()
+  '(telephone-line-defsegment* telephone-line-ryo-modal-segment ()
      (let ((tag (if ryo-modal-mode
                     "RYO" "EMACS")))
        (if telephone-line-evil-use-short-tag
@@ -129,9 +128,8 @@ mouse-3: Toggle minor modes"
          tag))))
 
 (eval-after-load 'workgroups2
-  '(telephone-line-defsegment telephone-line-workgroups2-segment ()
-     (wg-mode-line-string)
-     :preformatted t))
+  '(telephone-line-defsegment* telephone-line-workgroups2-segment ()
+     (telephone-line-raw (wg-mode-line-string) t)))
 
 (provide 'telephone-line-segments)
 ;;; telephone-line-segments.el ends here
diff --git a/telephone-line-utils.el b/telephone-line-utils.el
index d8e721389c..7301879c81 100644
--- a/telephone-line-utils.el
+++ b/telephone-line-utils.el
@@ -1,4 +1,4 @@
-;;; telephone-line-utils.el --- Functions for defining segparators and segments
+;;; telephone-line-utils.el --- Functions for defining segparators and 
segments -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2015-2017 Daniel Bordak
 
@@ -185,18 +185,23 @@ color1 and color2."
             body)))
 
 (cl-defmethod telephone-line-separator-create-body ((obj 
telephone-line-subseparator))
+  "Create a bytestring of a PBM image body of dimensions WIDTH and HEIGHT, and 
shape created from AXIS-FUNC and PATTERN-FUNC.
+
+Includes padding."
   (telephone-line--pad-body (cl-call-next-method)
                             (+ (ceiling (telephone-line-separator-width obj)
                                         (frame-char-width))
                                telephone-line-separator-extra-padding)))
 
-(cl-defmethod telephone-line-separator--arg-handler (arg) :static
+(cl-defmethod telephone-line-separator--arg-handler (arg)
   "Translate ARG into an appropriate color for a separator."
   (if (facep arg)
       (face-attribute arg :background)
     arg))
 
 (cl-defmethod telephone-line-separator-render-image ((obj 
telephone-line-separator) foreground background)
+  "Find cached pbm of OBJ in FOREGROUND and BACKGROUND.
+If it doesn't exist, create and cache it."
   (let ((hash-key (concat background "_" foreground)))
     ;; Return cached image if we have it.
     (or (gethash hash-key (oref obj image-cache))
@@ -224,22 +229,25 @@ color1 and color2."
   (clrhash (oref obj image-cache)))
 
 ;;;###autoload
-(cl-defmacro telephone-line-defsegment (name args body &key preformatted)
-  "Create function NAME by wrapping BODY with telephone-line padding and 
propertization."
-  (declare (indent defun))
-  `(defun ,name (face)
-     (telephone-line-raw ,body ,preformatted)))
+(defmacro telephone-line-defsegment* (name &rest body)
+  "Define NAME as a segment function.
 
-(defalias 'telephone-line-defsegment* #'telephone-line-defsegment)
+Does not check if segment is empty; will always display on non-nil result."
+  (declare (doc-string 3) (indent defun))
+  `(defun ,name
+     ,@(butlast body)
+     (lambda (face)
+       ,(car (last body)))))
 
 ;;;###autoload
-(defmacro telephone-line--defsegment-plist (name args plists)
-  (declare (indent defun))
-  `(defun ,name (face)
-     (telephone-line-raw
-      (mapcar (lambda (plist)
-                (plist-put plist 'face face))
-              ,plists))))
+(defmacro telephone-line-defsegment (name &rest body)
+  "Define NAME as a segment function.
+
+Empty strings will not render."
+  (declare (doc-string 3) (indent defun))
+  `(telephone-line-defsegment* ,name
+     ,@(butlast body)
+     (telephone-line-raw ,(car (last body)))))
 
 ;;;###autoload
 (defun telephone-line-raw (str &optional preformatted)
@@ -248,6 +256,8 @@ Return nil for blank/empty strings."
   (let ((trimmed-str (string-trim (format-mode-line str))))
     (unless (seq-empty-p trimmed-str)
       (if preformatted
+          ; format-mode-line will condense all escaped %s, so we need
+          ; to re-escape them.
           (replace-regexp-in-string "%" "%%" trimmed-str)
         str))))
 
@@ -255,7 +265,7 @@ Return nil for blank/empty strings."
 (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-plist\\>"
+                  '("\\<telephone-line-defsegment*\\>"
                     "\\<telephone-line-defsegment\\>")))
 
 (unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
diff --git a/telephone-line.el b/telephone-line.el
index d4b8f22b41..8d16590932 100644
--- a/telephone-line.el
+++ b/telephone-line.el
@@ -244,7 +244,7 @@ Secondary separators do not incur a background color 
change."
   "Normalize SUBSEGMENTS to create a strict list of functions."
   (mapcar (lambda (subsegment)
             (if (functionp subsegment)
-                subsegment
+                (funcall subsegment)
               (seq-let (segment-func &rest modifiers) subsegment
                 (cond
                  ((seq-contains modifiers ':active)