111808f4323a — xaltsc 2 years ago 
update 09/22
- Ignore empty segments
- More customizable variables
- Change the type of segment lists from an ad hoc one to a true list
patch browse 
1 files changed, 282 insertions(+), 140 deletions(-)

M xc-look-mode-line.el

M xc-look-mode-line.el +282 -140
@@ 4,171 4,226 @@ 
 ;; Default colours based off IBM's Carbon Design Language
 
 (defgroup xc-line nil
-  "lel"
+  "xaltsc's config modeline"
   :group 'mode-line)
 
-(defface xc-line-part-a-normal
+
+;; The mode-line is organized in segments as [a b c       x y z]
+
+
+;; Library -- Utility functions used throughout this file
+
+(require 's)
+(require 'dash)
+
+(defun --xc-line/try-trim (obj)
+  "Try to trim the object `obj` if it is a string or is a symbol bound to a string"
+  (let ((maybe-str (or (and (symbolp obj) (boundp obj) (symbol-value obj))
+                       obj)))
+    (if (stringp maybe-str) (s-trim maybe-str) maybe-str)))
+
+(defun --xc-line/escape-percent-construct (string)
+  "Escape percents in a string"
+  (replace-regexp-in-string "\\(%\\)" "\\1\\1" string))
+
+;; Faces depending on the evil mode
+
+(defface xc-line/part-a-normal
    '((t (:background "#0043ce"
          :foreground "#f2f4f8"
          :bold t :extend t)))
    "Face for the leftmost part when Evil is in normal mode"
    :group 'xc-line)
-(defface xc-line-part-a-insert
+
+(defface xc-line/part-a-insert
    '((t (:background "#f1c21b"
          :foreground "#21272a"
          :bold t)))
    "Face for the leftmost part when Evil is in insert mode"
    :group 'xc-line)
-(defface xc-line-part-a-visual
+
+(defface xc-line/part-a-visual
    '((t (:background "#007d79"
          :foreground "#f2f4f8"
          :bold t)))
-  "Face for the leftmost part when Evil is in visual mode"
+   "Face for the leftmost part when Evil is in visual mode"
    :group 'xc-line)
-(defface xc-line-part-a-replace
+
+(defface xc-line/part-a-replace
    '((t (:background "#da1e28"
          :foreground "#f2f4f8"
          :bold t)))
-  "Face for the leftmost part when Evil is in replace mode"
+   "Face for the leftmost part when Evil is in replace mode"
    :group 'xc-line)
-(defface xc-line-part-a-operator
+
+(defface xc-line/part-a-operator
    '((t (:background "#21272a"
          :foreground "#f2f4f8"
          :bold t)))
-  "Face for the leftmost part when Evil is in operator mode"
+   "Face for the leftmost part when Evil is in operator mode"
    :group 'xc-line)
-(defface xc-line-part-a-emacs
+
+(defface xc-line/part-a-emacs
    '((t (:background "#8a3ffc"
          :foreground "#f2f4f8"
          :bold t)))
-  "Face for the leftmost part when Evil is in Emacs mode"
+   "Face for the leftmost part when Evil is in Emacs mode"
+   :group 'xc-line)
+
+(defface xc-line/part-a-motion
+   '((t (:inherit xc-line/part-a-operator)))
+   "Face for the leftmost part when Evil is in motion mode"
+   :group 'xc-line)
+
+(defface xc-line/part-z-normal
+   '((t (:inherit (xc-line/part-a-normal))))
+   "Face for the rightmost part when Evil is in normal mode"
+   :group 'xc-line)
+
+(defface xc-line/part-z-insert
+   '((t (:inherit (xc-line/part-a-insert))))
+   "Face for the rightmost part when Evil is in insert mode"
+   :group 'xc-line)
+
+(defface xc-line/part-z-visual
+   '((t (:inherit (xc-line/part-a-visual))))
+   "Face for the rightmost part when Evil is in visual mode"
    :group 'xc-line)
-(defface xc-line-part-a-motion
-   '((t (:inherit xc-line-part-a-operator)))
-  "Face for the leftmost part when Evil is in motion mode"
+
+(defface xc-line/part-z-replace
+   '((t (:inherit (xc-line/part-a-replace))))
+   "Face for the rightmost part when Evil is in replace mode"
+   :group 'xc-line)
+
+(defface xc-line/part-z-operator
+   '((t (:inherit (xc-line/part-a-operator))))
+   "Face for the rightmost part when Evil is in operator mode"
    :group 'xc-line)
-(defface xc-line-part-b
+
+(defface xc-line/part-z-emacs
+   '((t (:inherit (xc-line/part-a-emacs))))
+   "Face for the rightmost part when Evil is in Emacs mode"
+   :group 'xc-line)
+
+(defface xc-line/part-z-motion
+   '((t (:inherit (xc-line/part-a-motion))))
+   "Face for the rightmost part when Evil is in motion mode"
+   :group 'xc-line)
+
+;; Faces for the other segments
+
+(defface xc-line/part-b
    '((t (:background "#c1c7cd" :foreground "#343a3f")))
   "Face for the second leftmost part"
    :group 'xc-line)
-(defface xc-line-part-c
+
+(defface xc-line/part-c
    '((t (:foreground "#4d5558")))
   "Face for the third leftmost part"
    :group 'xc-line)
 
-(defface xc-line-part-x
-   '((t (:inherit (xc-line-part-c))))
+(defface xc-line/part-x
+   '((t (:inherit (xc-line/part-c))))
   "Face for the third rightmost part"
    :group 'xc-line)
-(defface xc-line-part-y
-   '((t (:inherit (xc-line-part-b))))
+
+(defface xc-line/part-y
+   '((t (:inherit (xc-line/part-b))))
   "Face for the second rightmost part"
    :group 'xc-line)
 
-(defface xc-line-part-z-normal
-   '((t (:inherit (xc-line-part-a-normal))))
-  "Face for the rightmost part when Evil is in normal mode"
-   :group 'xc-line)
-(defface xc-line-part-z-insert
-   '((t (:inherit (xc-line-part-a-insert))))
-  "Face for the rightmost part when Evil is in insert mode"
-   :group 'xc-line)
-(defface xc-line-part-z-visual
-   '((t (:inherit (xc-line-part-a-visual))))
-  "Face for the rightmost part when Evil is in visual mode"
-   :group 'xc-line)
-(defface xc-line-part-z-replace
-   '((t (:inherit (xc-line-part-a-replace))))
-  "Face for the rightmost part when Evil is in replace mode"
-   :group 'xc-line)
-(defface xc-line-part-z-operator
-   '((t (:inherit (xc-line-part-a-operator))))
-  "Face for the rightmost part when Evil is in operator mode"
-   :group 'xc-line)
-(defface xc-line-part-z-emacs
-   '((t (:inherit (xc-line-part-a-emacs))))
-  "Face for the rightmost part when Evil is in Emacs mode"
-   :group 'xc-line)
-(defface xc-line-part-z-motion
-   '((t (:inherit (xc-line-part-a-motion))))
-  "Face for the rightmost part when Evil is in motion mode"
-   :group 'xc-line)
-(defface xc-line-container
-   '((t (:box (:line-width (-1 . 7)
+(defface xc-line/container
+   '((t (:box (:line-width (-1 . 2)
                :style flat-button))))
   "Additional face applied to all the components of the mode line"
   :group 'xc-line)
 
+;; UI Customization
 
-(defcustom xc-line-separator " · "
-   "Divider string between segments in a part")
+(defcustom xc-line/separator " · "
+  "Divider string between segments in a part"
+  :type 'string
+  :group 'xc-line)
 
-(defcustom xc-line-modified "+"
-   "Icon for when the buffer has been modified")
+(defcustom xc-line/modified "+"
+  "Icon for when the buffer has been modified"
+  :type 'string
+  :group 'xc-line)
 
-(defcustom xc-line-readonly ""
-    "Icon for when the buffer is read-only")
+(defcustom xc-line/readonly ""
+  "Icon for when the buffer is read-only"
+  :type 'string
+  :group 'xc-line)
 
-(require 's)
-(require 'dash)
+(defcustom xc-line/progress-bottom "⊥"
+  "Icon for when the buffer is at the bottom"
+  :type 'string
+  :group 'xc-line)
 
-(defun --escape-percent-construct (string)
-   (replace-regexp-in-string "\\(%\\)" "\\1\\1" string))
+(defcustom xc-line/progress-top "⊤"
+  "Icon for when the buffer is at the top"
+  :type 'string
+  :group 'xc-line)
 
-;(defun --merge-face-in-list (sexp face-to-merge)
-;  (let ((head (car sexp)))
-;    (if (eq :propertize head)
-;        (let* ((copied-sexp (-copy sexp))
-;               (face-field (plist-get copied-sexp 'face))
-;;          (if face-field
-;              (cond
-;               ((and (listp face-field) (not (memq face-to-merge face-field)))
-;                (plist-put copied-sexp 'face
-;                    (append face-field (list face-to-merge))
-;               ((not (or (listp face-field) (eq face-field face-to-merge)))
-;                (plist-put copied-sexp 'face (list face-field face-to-merge))
-;               (t copied-sexp)
-;              (plist-put copied-sexp 'face face-to-merge)
-;     sexp))
+(defcustom xc-line/progress-all "∀"
+  "Icon for when the buffer is shown entirely"
+  :type 'string
+  :group 'xc-line)
+
+
+
 
-;(defun --merge-face-properties (sexp face-to-merge)
-;  (if (proper-list-p sexp)
-;      (mapcar (-cut --merge-face-properties <> face-to-merge)
-;              (--merge-face-in-list sexp face-to-merge)
-;      sexp)))
-;
+(defcustom xc-line/evil-mode-abbreviations
+  '((normal   . "NOR")
+    (insert   . "INS")
+    (visual   . "VIS")
+    (operator . "OP")
+    (replace  . "REP")
+    (motion   . "MOT")
+    (emacs    . "EMX"))
+  "Abbreviation for evil modes to be used as the string indicating the mode"
+  :group 'xc-line
+  :type '(alist :key-type (choice (const :tag "Normal Mode" normal)
+                                  (const :tag "Insert Mode" insert)
+                                  (const :tag "Visual Mode" visual)
+                                  (const :tag "Operator Mode" operator)
+                                  (const :tag "Replace Mode" replace)
+                                  (const :tag "Motion Mode" motion)
+                                  (const :tag "Emacs Mode" emacs))
+                :value-type (string :tag "Abbreviation")))
+
+
 (defun xc-line/centre-space (right-length)
    "Creates the space for the centre of the mode line"
    `(:propertize " " display (space :align-to (- right (- 0 right-margin)
-                                                 ,right-length))))
+                                                ,right-length))))
 
-(defun xc-line/format-part-expand-symbols (sym)
+(defun --xc-line/format-part-expand-symbols (sym)
     "Expands symbols when they are bound"
     (if (and (symbolp sym) (boundp sym))
         (symbol-value sym)
         sym))
 
-(defun format-and-escape (format-spec)
-   (--escape-percent-construct (format-mode-line format-spec)))
+(defun --xc-line/format-and-escape (format-spec)
+   (--xc-line/escape-percent-construct (format-mode-line format-spec)))
 
 (defun xc-line/format-part (part face &optional extra-right-space-p)
-  "Formats `part' of the mode line while adding the face `face' at the end of
+  "Formats `part' (must be a list of segments) of the mode line while adding the face `face' at the end of
    the face text property of its components. Adds an extra space at the end if
    `extra-right-space-p' is non-nil.
 
    Returns the resulting string."
-  (let* ((part-elt (if (and (listp part) (eq (car part) :multi))
-                       (-interpose xc-line-separator
-                                   (mapcar #'xc-line/format-part-expand-symbols
-                                           (cdr part)))
-                       part))
-         (formatted-part (format-and-escape
+  (let* ((part-elt (-interpose xc-line/separator
+                       (mapcar #'--xc-line/format-part-expand-symbols
+                               part)))
+         (formatted-part (--xc-line/format-and-escape
                           (list " " part-elt " "
                                (and extra-right-space-p " "))))
          (f-p-length (length formatted-part)))
     (add-face-text-property 0 f-p-length face t formatted-part)
     formatted-part))
 
+
 ;    (part-w-face `(:eval (--merge-face-properties ',part-elt ',face)))
 ;    `(:propertize (" " ,part-w-face " " ,)
 ;            face ,face))

          
@@ 177,83 232,170 @@ 
   "Gets the correct face for the segment `seg-identifier' according to the
    current `evil-state'"
 
-  (let ((face-string (format "xc-line-part-%s-%s" seg-identifier evil-state)))
+  (let ((face-string (format "xc-line/part-%s-%s" seg-identifier evil-state)))
     (intern face-string)))
 
 (defun xc-line/format-left (a b c)
   "Makes the left part of the mode line"
   (let ((a-propd (xc-line/format-part a (xc-line/get-face-for-mode 'a)))
-        (b-propd (xc-line/format-part b 'xc-line-part-b))
-        (c-propd (xc-line/format-part c 'xc-line-part-c)))
+        (b-propd (xc-line/format-part b 'xc-line/part-b))
+        (c-propd (xc-line/format-part c 'xc-line/part-c)))
     (list a-propd b-propd c-propd)))
 
 (defun xc-line/format-right (x y z)
   "Makes the right part of the mode line"
-  (let ((x-propd (xc-line/format-part x 'xc-line-part-x))
-        (y-propd (xc-line/format-part y 'xc-line-part-y))
+  (let ((x-propd (xc-line/format-part x 'xc-line/part-x))
+        (y-propd (xc-line/format-part y 'xc-line/part-y))
         (z-propd (xc-line/format-part z (xc-line/get-face-for-mode 'z) t)))
     (list x-propd y-propd z-propd)))
 
+(defun xc-line/get-left-part ()
+  "Get the left part of the mode-line"
+  (-filter (lambda (s) (> (length (s-trim s)) 0))
+   (xc-line/format-left xc-line/segments-a xc-line/segments-b xc-line/segments-c)))
+
+(defun xc-line/get-right-part ()
+  "Get the right part of the mode-line"
+  (-filter (lambda (s) (> (length (s-trim s)) 0))
+   (xc-line/format-right xc-line/segments-x xc-line/segments-y xc-line/segments-z)))
+
 (defun xc-line/format (left right)
   "Makes the mode line format"
 
   (let* ((middle (xc-line/centre-space
                   (- (length (format-mode-line right)) 1)))
-         (mode-line-string (format-and-escape (list left middle right)))
+         (mode-line-string (--xc-line/format-and-escape (list left middle right)))
          (mls-length (length mode-line-string)))
-     (add-face-text-property 0 mls-length 'xc-line-container t mode-line-string)
+     (add-face-text-property 0 mls-length 'xc-line/container t mode-line-string)
      mode-line-string))
 
-(setq xc-line/seg-evil
-  '(:eval (s-pad-right 3 " " (plist-get '(normal "NOR"
-                                          insert "INS"
-                                          visual "VIS"
-                                          operator "OP"
-                                          replace "REP"
-                                          motion "MOT"
-                                          emacs "EMX")
-                                evil-state))))
+(defun xc-line/get-line ()
+  "Get the mode-line"
+  (xc-line/format (xc-line/get-left-part) (xc-line/get-right-part)))
+
+;; Segment variables
+
+(defcustom xc-line/segments-a
+ '(xc-line/seg-evil)
+ "Segment(s) for the a part"
+ :type '(repeat sexp)
+ :group 'xc-line)
+ 
+(defcustom xc-line/segments-b
+  '(xc-line/seg-misc-info)
+  "Segment(s) for the b part"
+  :type '(repeat sexp)
+  :group 'xc-line)
 
-(defun xc-line/seg-buffer-status ()
-   (let ((modified (if (buffer-modified-p) xc-line-modified ""))
-         (readonly (if buffer-read-only    xc-line-readonly "")))
-     (format "%s%s" modified readonly)))
+(defcustom xc-line/segments-c
+  '(xc-line/seg-buffer)
+  "Segment(s) for the c part"
+  :type '(repeat sexp)
+  :group 'xc-line)
+
+(defcustom xc-line/segments-x
+  '(xc-line/seg-minor-modes)
+  "Segment(s) for the x part"
+  :type '(repeat sexp)
+  :group 'xc-line)
+
+(defcustom xc-line/segments-y
+  '(xc-line/seg-progress)
+  "Segment(s) for the y part"
+  :type '(repeat sexp)
+  :group 'xc-line)
+
+(defcustom xc-line/segments-z
+  '(xc-line/seg-position xc-line/seg-major-mode)
+  "Segment(s) for the z part"
+  :type '(repeat sexp)
+  :group 'xc-line)
+
+;; Provided segments
 
-(setq xc-line/seg-buffer
-   '("%b" (:eval (xc-line/seg-buffer-status))))
+(defvar xc-line/seg-major-mode
+  'mode-name
+  "Segment displaying the major mode")
+
+(defvar xc-line/seg-minor-modes
+  '(:eval minor-mode-alist)
+  "Segment displaying the minor modes")
 
-(setq xc-line/seg-major-mode
-   'mode-name)
+(defvar xc-line/seg-misc-info
+  '(:eval (mapcar #'--xc-line/try-trim global-mode-string))
+  "Segment displaying other information coming from the `global-mode-string` variable")
+
+(defun --xc-line/seg-buffer-helper ()
+  "Helper function for the segment displaying the buffer status"
+  (let ((modified (if (buffer-modified-p) xc-line/modified ""))
+        (readonly (if buffer-read-only    xc-line/readonly "")))
+    (format "%s%s" modified readonly)))
+
+(defvar xc-line/seg-buffer
+  '("%b" (:eval (--xc-line/seg-buffer-helper)))
+  "Segment displaying the buffer status")
 
-(setq xc-line/seg-minor-modes
-   'minor-mode-alist)
+(defvar xc-line/seg-evil
+  '(:eval (s-pad-right 3 " " (alist-get evil-state xc-line/evil-mode-abbreviations)))
+  "Segment displaying the evil mode")
 
-(defun --xc-line/try-trim (obj)
-   (let ((maybe-str (or (and (symbolp obj) (boundp obj) (symbol-value obj))
-                        obj)))
-     (if (stringp maybe-str) (s-trim maybe-str) maybe-str)))
+(defvar xc-line/seg-progress
+  '(:eval (downcase (--xc-line/escape-percent-construct
+                        (let ((progress (format-mode-line '(-3 "%p"))))
+                          (cond
+                             ((string-equal-ignore-case progress "bot") xc-line/progress-bottom)
+                             ((string-equal-ignore-case progress "top") xc-line/progress-top)
+                             ((string-equal-ignore-case progress "all") xc-line/progress-all)
+                             (t progress))))))
+  "Segment displaying the progress on the buffer")
 
-(setq xc-line/seg-misc-info
-      '(:eval (mapcar #'--xc-line/try-trim global-mode-string)))
+(defvar xc-line/seg-position
+  '(:eval (--xc-line/escape-percent-construct
+              (s-pad-left 6 " " (format-mode-line "%l:%c"))))
+  "Segment displaying the position on the buffer")
+
+(defcustom xc-line/mode-line
+  '(:eval (xc-line/get-line))
+  "xaltsc's config mode-line"
+  :group 'xc-line)
 
 
-(setq xc-line/seg-progress
-      '(:eval (downcase (--escape-percent-construct
-                            (format-mode-line '(-3 "%p"))))))
+;; Minor mode
+
+(defvar --xc-line/saved-mode-line-format nil)
+(defvar --xc-line/saved-header-line-format nil)
 
-(setq xc-line/seg-position
-      '(:eval (--escape-percent-construct
-                  (s-pad-left 6 " " (format-mode-line "%l:%c")))))
+(defun xc-line/mode-activate ()
+  (unless --xc-line/saved-mode-line-format
+    (setq --xc-line/saved-mode-line-format mode-line-format)
+    (setq --xc-line/saved-header-line-format header-line-format))
+
+  (setq mode-line-format xc-line/mode-line)
+  (setq-default mode-line-format xc-line/mode-line)
 
-(defcustom xc-line/mode-line
-    '(:eval (xc-line/format
-             (xc-line/format-left xc-line/seg-evil
-                                  xc-line/seg-misc-info
-                                  xc-line/seg-buffer)
-             (xc-line/format-right xc-line/seg-minor-modes
-                                   xc-line/seg-progress
-                                   (list :multi xc-line/seg-position
-                                                xc-line/seg-major-mode))))
-  "xaltsc's config mode-line")
+  (force-mode-line-update t))
+  
+(defun xc-line/mode-deactivate ()
+  (setq         mode-line-format --xc-line/saved-mode-line-format)
+  (setq-default mode-line-format --xc-line/saved-mode-line-format)
+  (setq         header-line-format --xc-line/saved-header-line-format)
+  (setq-default header-line-format --xc-line/saved-header-line-format))
+  
+
+;;;###autoload
+(define-minor-mode xc-line-mode
+  "Toggle xc-line minor mode"
+  :group 'xc-line
+  :global t
+  :init-value nil
+
+  (if xc-line-mode
+      (xc-line/mode-activate)
+    (xc-line/mode-deactivate))
+
+  ;; Run any registered hooks
+  (run-hooks 'xc-line-mode-hook))
+
 
 (provide 'xc-look-mode-line)
+;;; xc-look-mode-line.el ends here