Add the right half of the mode line.

1 files changed, 403 insertions, 32 deletions

diff --git a/modeline.el b/modeline.el
index a564a10..54bee5c 100644
--- a/modeline.el
+++ b/modeline.el
@@ -1,21 +1,142 @@
+;;; -*- lexical-binding: t; -*-
+
 ;;;###autoload
 (defun modeline-format-main ()
   "The main mode line format."
-  (let ((left (modeline-format-left))
-	(right (modeline-format-right))
-	(left-len (length left))
-	(right-len (length right))
-	(middle (propertize " " 'display
-			    (make-string (- (window-width)
-					    left-len
-					    right-len)
-					 32))))
+  (let* ((left (modeline-format-left))
+         (right (modeline-format-right))
+         (left-len (length left))
+         (right-len (length right))
+         (middle (propertize " " 'display
+                             (make-string (- (window-width)
+                                             left-len
+                                             right-len)
+                                          32))))
     (concat left middle right)))
 
+(setq-default mode-line-format '("%e" (:eval (modeline-format-main))))
+
 ;;;###autoload
 (defun modeline-format-left ()
   "The left mode line format."
-  )
+  (concat
+   (modeline-format-bar)
+   (modeline-spc)
+   (modeline-format-buffer-status)
+   (modeline-spc)
+   (modeline-format-buffer-name)
+   (modeline-spc)
+   (modeline-format-position)
+   (modeline-spc)
+   (modeline-format-buffer-size)))
+
+;;;###autoload
+(defun modeline-format-right ()
+  "The right mode line format."
+  (concat
+   (modeline-format-major-mode)
+   (modeline-format-vc-mode)))
+
+;;; Conveniently add text properties
+
+;;;###autoload
+(defmacro modeline-propertize (str &optional mouse-face help-echo map)
+  "Give STR appropriate text properties.
+MOUSE-FACE is used when the mouse is over the text.
+HELP-ECHO is the additional information displayed when the mouse is over the text.
+MAP is the local keymap of the text."
+  (let ((mouse-face (or mouse-face 'mode-line-highlight)))
+    `(propertize ,str
+      'mouse-face ',mouse-face
+      'help-echo ,help-echo
+      'local-map ,map)))
+
+;;; Determination of the active mode-line
+
+;; NOTE: I tried to avoid this, but it turns out that this is the most
+;; reliable way to do so.
+
+;;;###autoload
+(defun modeline-get-active-window (&optional frame)
+  "The active window excluding the child windows."
+  (if (and (fboundp 'frame-parent) (frame-parent frame))
+      (frame-selected-window (frame-parent frame))
+    (frame-selected-window frame)))
+
+;;;###autoload
+(defvar modeline-active-window (modeline-get-active-window)
+  "The active window excluding the child windows.")
+
+;;;###autoload
+(defun modeline-active-window-p ()
+  "Whether we are in the active window."
+  (and modeline-active-window
+       (eq modeline-active-window (selected-window))))
+
+;;;###autoload
+(defun modeline-set-active-window (&rest _)
+  "Update `modeline-active-window'."
+  (let ((active-wn (modeline-get-active-window)))
+    (cond
+     ((minibuffer-window-active-p active-wn))
+     (t (setq modeline-active-window active-wn))))
+  (force-mode-line-update t))
+
+;;;###autoload
+(defsubst modeline-unset-active-window (&rest _)
+  "Set `modeline-active-window' to `nil'."
+  (setq modeline-active-window nil))
+
+;;;###autoload
+(defun modeline-refresh-modeline ()
+  "Refresh the focus state of the mode line."
+  (setq modeline-active-window nil)
+  (mapc (lambda (frame)
+	  (cond ((eq (frame-focus-state frame) t)
+		 (setq modeline-active-window (modeline-get-active-window frame)))))
+	(frame-list)))
+
+(add-hook 'window-configuration-change-hook #'modeline-set-active-window)
+(add-hook 'buffer-list-update-hook #'modeline-set-active-window)
+(add-hook 'after-make-frame-functions #'modeline-set-active-window)
+(add-hook 'delete-frame-functions #'modeline-set-active-window)
+(advice-add #'handle-switch-frame :after #'modeline-set-active-window)
+(add-function :after after-focus-change-function #'modeline-refresh-modeline)
+
+;;; Faces
+
+;; NOTE: These faces are not actually defined here.
+;;       They are found here simply because they need to have a formal declaration to work.
+
+;;;###autoload
+(defface doom-modeline-buffer-modified nil
+  "The face for mode line buffer identification.")
+
+;;;###autoload
+(defface doom-modeline-warning nil
+  "The face for mode line warning.")
+
+;;;###autoload
+(defface doom-modeline-urgent nil
+  "The face for mode line urgent.")
+
+;;;###autoload
+(defface doom-modeline-info nil
+  "The face for mode line info.")
+
+;;;###autoload
+(defface doom-modeline-buffer-major-mode nil
+  "The face for mode line major mode.")
+
+;;; Various sections of the mode line
+
+;;;###autoload
+(defun modeline-spc ()
+  "A space with the appropriate face."
+  (format-mode-line " "
+		    (cond ((modeline-active-window-p)
+			   'mode-line)
+			  (t 'mode-line-inactive))))
 
 ;;;###autoload
 (defvar modeline-bar-width 3
@@ -26,41 +147,291 @@
   "The height of the mode line bar")
 
 ;;;###autoload
+(defvar modeline-bar-color (face-background 'modus-theme-active-blue nil t)
+  "The color for the bar of the mode line.")
+
+;;;###autoload
+(defvar modeline-bar-color-inactive (face-foreground 'mode-line-inactive)
+  "The color for the bar of inactive mode lines.")
+
+;;;###autoload
+(defvar modeline-bar-img
+  (propertize
+   " " 'display
+   (let ((data (make-list modeline-bar-height
+                          (make-list modeline-bar-width 97)))
+         (color modeline-bar-color))
+     (ignore-errors
+       (create-image
+        (concat
+         "/* XPM */\nstatic char * bar[]={\n"
+         (format "\"%d %d 1 1\",\n\"a c %s\",\n"
+                 modeline-bar-width modeline-bar-height
+                 color)
+         (mapconcat
+          (lambda (row)
+            (format "\"%s\""
+                    (apply #'string row)))
+          data ",\n")
+         "\n};")
+        'xpm t :ascent 'center))))
+  "The image for the bar in the mode line.")
+
+;;;###autoload
+(defvar modeline-bar-img-inactive
+  (propertize
+   " " 'display
+   (let ((data (make-list modeline-bar-height
+                          (make-list modeline-bar-width 97)))
+         (color modeline-bar-color-inactive))
+     (ignore-errors
+       (create-image
+        (concat
+         "/* XPM */\nstatic char * bar[]={\n"
+         (format "\"%d %d 1 1\",\n\"a c %s\",\n"
+                 modeline-bar-width modeline-bar-height
+                 color)
+         (mapconcat
+          (lambda (row)
+            (format "\"%s\""
+                    (apply #'string row)))
+          data ",\n")
+         "\n};")
+        'xpm t :ascent 'center))))
+  "The image for the bar in inactive mode lines.")
+
+;;;###autoload
+(defun modeline-refresh-bars (&optional w h)
+  "Refresh the bar images.
+W is the width, H is the height of the bar."
+  (setq modeline-bar-width (or w modeline-bar-width)
+        modeline-bar-height (or h modeline-bar-height)
+        modeline-bar-img
+          (propertize
+           " " 'display
+           (let ((data (make-list modeline-bar-height
+                                  (make-list modeline-bar-width 97)))
+                 (color modeline-bar-color))
+             (ignore-errors
+               (create-image
+                (concat
+                 "/* XPM */\nstatic char * bar[]={\n"
+                 (format "\"%d %d 1 1\",\n\"a c %s\",\n"
+                         modeline-bar-width modeline-bar-height
+                         color)
+                 (mapconcat
+                  (lambda (row)
+                    (format "\"%s\""
+                            (apply #'string row)))
+                  data ",\n")
+                 "\n};")
+                'xpm t :ascent 'center))))
+	  modeline-bar-img-inactive
+	  (propertize
+           " " 'display
+           (let ((data (make-list modeline-bar-height
+                                  (make-list modeline-bar-width 97)))
+                 (color modeline-bar-color-inactive))
+             (ignore-errors
+               (create-image
+                (concat
+                 "/* XPM */\nstatic char * bar[]={\n"
+                 (format "\"%d %d 1 1\",\n\"a c %s\",\n"
+                         modeline-bar-width modeline-bar-height
+                         color)
+                 (mapconcat
+                  (lambda (row)
+                    (format "\"%s\""
+                            (apply #'string row)))
+                  data ",\n")
+                 "\n};")
+                'xpm t :ascent 'center))))))
+
+;;;###autoload
 (defun modeline-format-bar ()
   "We need a bar to ensure the mode line has the specified height."
   (cond
    ((and (display-graphic-p)
          (image-type-available-p 'xpm))
-    (propertize
-     " " 'display
-     (let ((data (make-list modeline-bar-height
-			    (make-list modeline-bar-width 97)))
-	   (color (face-background 'modus-theme-active-blue nil t)))
-       (ignore-errors
-	 (create-image
-	  (concat
-	   "/* XPM */\nstatic char * bar[]={\n"
-	   (format "\"%d %d 1 1\",\n\"a c %s\",\n"
-		   modeline-bar-width modeline-bar-height
-		   color)
-	   (mapconcat
-	    (lambda (row)
-	      (format "\"%s\""
-		      (apply #'string row)))
-	    data ",\n")
-	   "\n};")
-	  'xpm t :ascent 'center)))))))
+    (cond ((modeline-active-window-p) modeline-bar-img)
+	  (t modeline-bar-img-inactive)))))
 
 ;;;###autoload
-(defun modeline-format-right ()
-  "The right mode line format.")
+(defun modeline-format-buffer-status ()
+  "The status of the buffer displayed on the mode-line."
+  (let ((active-p (modeline-active-window-p)))
+    (concat
+     ;; modified or not
+     (cond ((and buffer-file-name (buffer-modified-p))
+            (format-mode-line "M" (cond
+				   (active-p
+				    'doom-modeline-buffer-modified)
+				   (t 'mode-line-inactive)))))
+     ;; read-only?
+     (cond
+      (buffer-read-only
+       (format-mode-line "R" (cond
+			      (active-p
+			       'doom-modeline-urgent)
+			      (t 'mode-line-inactive)))))
+     ;; narrow?
+     (cond
+      ((buffer-narrowed-p)
+       (format-mode-line "N" (cond
+			      (active-p
+			       'doom-modeline-warning)
+			      (t 'mode-line-inactive))))))))
 
+;;;###autoload
+(defun modeline-format-position ()
+  "The position of the cursor to be displayed in the mode line."
+  (modeline-propertize
+   (format-mode-line
+    (concat "%l:%C "
+	    (let ((orig (format-mode-line "%p")))
+	      (cond
+	       ((memq (aref orig 0) (number-sequence 48 57))
+		(concat orig "%%%"))
+	       (t (substring orig 0 3)))))
+    (cond
+     ((modeline-active-window-p) 'mode-line)
+     (t 'mode-line-inactive)))
+   nil
+   "Buffer position\nmouse-1: Display Line and Column Mode Menu"
+   mode-line-column-line-number-mode-map))
 
+;;;###autoload
+(defun modeline-format-buffer-size ()
+  "The size of the buffer to be displayed in the mode line."
+  (modeline-propertize
+   (format-mode-line
+    (file-size-human-readable (string-to-number (format-mode-line "%i")))
+    (cond
+     ((modeline-active-window-p)
+      'mode-line)
+     (t 'mode-line-inactive)))
+   nil
+   "Buffer size\nmouse-1: Display Line and Column Mode Menu"
+   mode-line-column-line-number-mode-map))
 
+;;;###autoload
+(defvar modeline-buffer-name-len-max 50
+  "The maximal length of the name of the buffer to be displayed in the mode line.")
 
+(let ((map (make-sparse-keymap)))
+  (define-key map [mode-line mouse-1] #'ibuffer)
+  (setq mode-line-buffer-identification-keymap
+	map))
 
+;;;###autoload
+(defun modeline-format-buffer-name ()
+  "The name of the buffer truncated to `modeline-buffer-name-len-max'.
+This will be displayed in the mode line."
+  (declare (pure t) (side-effect-free t))
+  (modeline-propertize
+   (let ((orig
+	  (format-mode-line
+	   "%b" (cond ((modeline-active-window-p)
+		       'mode-line-buffer-id)
+		      (t 'mode-line-inactive)))))
+     (cond
+      ((> (length orig) modeline-buffer-name-len-max)
+       (concat
+	(substring orig 0 (- modeline-buffer-name-len-max 3))
+	"..."))
+      (t orig)))
+   nil
+   (concat (buffer-file-name)
+		      "\n"
+		      "mouse-1: ibuffer")
+   mode-line-buffer-identification-keymap))
 
+;;;###autoload
+(defun modeline-format-major-mode ()
+  "The major mode to display in the mode line."
+  (declare (pure t) (side-effect-free t))
+  (modeline-propertize
+   (format-mode-line
+    "%m"
+    (cond ((modeline-active-window-p)
+	   'doom-modeline-buffer-major-mode)
+	  (t 'mode-line-inactive)))
+   nil
+   "Major mode\nmouse-1: Display major mode menu\nmouse-2: Show help for major mode\nmouse-3: Toggle minor modes"
+   mode-line-major-mode-keymap))
 
-(setq mode-line-format '("%e" (:eval (modeline-format-main))))
+;;;###autoload
+(defvar modeline-vcs-str ""
+  "Display the version control system information on the mode line.")
+;;;###autoload
+(defvar modeline-vcs-length-max 12
+  "The maximum displayed length of the branch name of version control.")
 
+;;;###autoload
+(defun modeline-update-vcs-str (&rest _)
+  "Update the version control system information to be displayed on the mode line."
+  (let ((bfn (buffer-file-name)))
+    (setq
+     modeline-vcs-str
+     (cond
+      ((and vc-mode bfn)
+       (let* ((backend (vc-backend bfn))
+	      (state (vc-state bfn backend))
+	      (indicator (cond
+			  ((memq state '(added edited))
+			   (format-mode-line
+			    "* " 'doom-modeline-info))
+			  ((eq state 'needs-merge)
+			   (format-mode-line
+			    "? " 'doom-modeline-info))
+			  ((eq state 'needs-update)
+			   (format-mode-line
+			    "! " 'doom-modeline-warning))
+			  ((memq state '(removed conflict unregistered))
+			   (format-mode-line
+			    "! " 'doom-modeline-urgent))
+			  (t (format-mode-line
+			      "@ " 'doom-modeline-info))))
+	      (str (cond (vc-display-status
+			  (substring vc-mode (+ (cond ((eq backend 'Hg) 2)
+						      (t 3))
+						2)))
+			 (t ""))))
+	 (concat
+	  indicator
+	  (propertize
+	   (cond
+	    ((> (length str) modeline-vcs-length-max)
+	     (concat (substring str 0 (- modeline-vcs-length-max 3))
+		     "..."))
+	    (t str))
+	   'face (cond
+		  ((eq state 'needs-update)
+		   'doom-modeline-warning)
+		  ((memq state '(removed conflict unregistered))
+		   'doom-modeline-urgent)
+		  (t 'doom-modeline-info))))))
+      (t "")))))
 
+(add-hook 'find-file-hook #'modeline-update-vcs-str)
+(add-hook 'after-save-hook #'modeline-update-vcs-str)
+(advice-add #'vc-refresh-state :after #'modeline-update-vcs-str)
+
+;;;###autoload
+(defun modeline-format-vc-mode ()
+  "Display version control system information on the mode line."
+  (declare (pure t) (side-effect-free t))
+  (cond
+   ((and (stringp modeline-vcs-str)
+	 (not (string= modeline-vcs-str "")))
+    (concat
+     (modeline-spc)
+     (modeline-propertize
+      (cond
+       ((modeline-active-window-p)
+	modeline-vcs-str)
+       (t (propertize modeline-vcs-str 'face 'mode-line-inactive)))
+      nil
+      (get-text-property 1 'help-echo vc-mode)
+      (get-text-property 1 'local-map vc-mode))
+     (modeline-spc)))))