Change modeline

author: Case Duckworth 2022-05-05 18:41:42 -0500
committer: Case Duckworth 2022-05-05 18:41:42 -0500
commit: f0febf681490412709be7b494232de8c41253769 (patch)
tree: 80e678d98f2496aa668caee22ad6b3276bcaa27f /lisp
parent: meh (diff)
download: emacs-f0febf681490412709be7b494232de8c41253769.tar.gz
emacs-f0febf681490412709be7b494232de8c41253769.zip
2 files changed, 106 insertions, 29 deletions
diff --git a/lisp/+Info.el b/lisp/+Info.el
index a3c2fcd..46bd5f8 100644
--- a/lisp/+Info.el
+++ b/lisp/+Info.el

@@ -13,5 +13,72 @@ arg reversed."
  (interactive "P" Info-mode)
  (Info-copy-current-node-name (unless arg 0)))
+(defun +Info-modeline-breadcrumbs ()
+  (let ((nodes   (Info-toc-nodes Info-current-file))
+        (node    Info-current-node)
+        (crumbs  ())
+        (depth   Info-breadcrumbs-depth-internal)
+        (text    ""))
+    ;; Get ancestors from the cached parent-children node info
+    (while (and (not (equal "Top" node))  (> depth 0))
+      (setq node  (nth 1 (assoc node nodes)))
+      (when node (push node crumbs))
+      (setq depth  (1- depth)))
+    ;; Add bottom node.
+    (setq crumbs  (nconc crumbs (list Info-current-node)))
+    (when crumbs
+      ;; Add top node (and continuation if needed).
+      (setq crumbs  (cons "Top" (if (member (pop crumbs) '(nil "Top"))
+                                    crumbs
+                                  (cons nil crumbs))))
+      (dolist (node  crumbs)
+        (let ((crumbs-map  (make-sparse-keymap))
+              (menu-map    (make-sparse-keymap "Breadcrumbs in Mode Line")))
+          (define-key crumbs-map [mode-line mouse-3] menu-map)
+          (when node
+            (define-key menu-map [Info-prev]
+                        `(menu-item "Previous Node" Info-prev
+                                    :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node"))
+            (define-key menu-map [Info-next]
+                        `(menu-item "Next Node" Info-next
+                                    :visible ,(Info-check-pointer "next") :help "Go to the next node"))
+            (define-key menu-map [separator] '("--"))
+            (define-key menu-map [Info-breadcrumbs-in-mode-line-mode]
+                        `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode
+                                    :help "Toggle displaying breadcrumbs in the Info mode-line"
+                                    :button (:toggle . Info-breadcrumbs-in-mode-line-mode)))
+            (define-key menu-map [Info-set-breadcrumbs-depth]
+                        `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth
+                                    :help "Set depth of breadcrumbs to show in the mode-line"))
+            (setq node  (if (equal node Info-current-node)
+                            (propertize
+                             (replace-regexp-in-string "%" "%%" Info-current-node)
+                             'face 'mode-line-buffer-id
+                             'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu"
+                             'mouse-face 'mode-line-highlight
+                             'local-map
+                             (progn
+                               (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down)
+                               (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up)
+                               crumbs-map))
+                          (propertize
+                           node
+                           'local-map (progn (define-key crumbs-map [mode-line mouse-1]
+                                                         `(lambda () (interactive) (Info-goto-node ,node)))
+                                             (define-key crumbs-map [mode-line mouse-2]
+                                                         `(lambda () (interactive) (Info-goto-node ,node)))
+                                             crumbs-map)
+                           'mouse-face 'mode-line-highlight
+                           'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu")))))
+        (let ((nodetext  (if (not (equal node "Top"))
+                             node
+                           (concat (format "(%s)" (if (stringp Info-current-file)
+                                                      (file-name-nondirectory Info-current-file)
+                                                    ;; Some legacy code can still use a symbol.
+                                                    Info-current-file))
+                                   node))))
+          (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "...")))))
+      text)))
 (provide '+Info)
 ;;; +Info.el ends here
diff --git a/lisp/+modeline.el b/lisp/+modeline.el
index 3a922e3..e5b5bc6 100644
--- a/lisp/+modeline.el
+++ b/lisp/+modeline.el

@@ -72,26 +72,34 @@ and appended with `truncate-string-ellipsis'."
                 (natnum :tag "Number of characters")
                 (float :tag "Fraction of window's width")))
+(defcustom +modeline-buffer-position nil
+  "What to put in the `+modeline-buffer-name' position."
+  :type 'function
+  :local t)
 (defun +modeline-buffer-name (&optional spacer)         ; gonsie
  "Display the buffer name."
  (let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))
    (concat (or spacer +modeline-default-spacer)
-            (propertize (cond
+            (if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
-                         ((ignore-errors
+                (funcall +modeline-buffer-position)
-                            (and (> +modeline-buffer-name-max-length 0)
+              (propertize (cond
-                                 (< +modeline-buffer-name-max-length 1)))
+                           ((ignore-errors
-                          (truncate-string-to-width bufname
+                              (and (> +modeline-buffer-name-max-length 0)
-                                                    (* (window-total-width) +modeline-buffer-name-max-length)
+                                   (< +modeline-buffer-name-max-length 1)))
-                                                    nil nil t))
+                            (truncate-string-to-width bufname
-                         ((ignore-errors
+                                                      (* (window-total-width)
-                            (> +modeline-buffer-name-max-length 1))
+                                                         +modeline-buffer-name-max-length)
-                          (truncate-string-to-width bufname
+                                                      nil nil t))
-                                                    +modeline-buffer-name-max-length
+                           ((ignore-errors
-                                                    nil nil t))
+                              (> +modeline-buffer-name-max-length 1))
-                         (t bufname))
+                            (truncate-string-to-width bufname
-                        'help-echo (or (buffer-file-name)
+                                                      +modeline-buffer-name-max-length
-                                       (buffer-name))
+                                                      nil nil t))
-                        'mouse-face 'mode-line-highlight))))
+                           (t bufname))
+                          'help-echo (or (buffer-file-name)
+                                         (buffer-name))
+                          'mouse-face 'mode-line-highlight)))))
 (defcustom +modeline-minions-icon "&"
  "The \"icon\" for `+modeline-minions' button."
@@ -152,17 +160,17 @@ The order of elements matters: whichever one matches first is applied."
 (defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified'
  "Display a color-coded \"icon\" indicator for the buffer's status."
  (let* ((icon (catch :icon
-                (dolist (cell +modeline-modified-icon-alist)
+                 (dolist (cell +modeline-modified-icon-alist)
-                  (when (pcase (car cell)
+                   (when (pcase (car cell)
-                          ('ephemeral (not (buffer-file-name)))
+                           ('ephemeral (not (buffer-file-name)))
-                          ('readonly buffer-read-only)
+                           ('readonly buffer-read-only)
-                          ('modified (buffer-modified-p))
+                           ('modified (buffer-modified-p))
-                          ('special
+                           ('special
-                           (apply 'derived-mode-p
+                            (apply 'derived-mode-p
-                                  +modeline-modified-icon-special-modes))
+                                   +modeline-modified-icon-special-modes))
-                          ('t t)
+                           ('t t)
-                          (_ nil))
+                           (_ nil))
-                    (throw :icon cell))))))
+                     (throw :icon cell))))))
    (concat (or spacer +modeline-default-spacer)
            (propertize (or (cdr-safe icon) "")
                        'help-echo (format "Buffer \"%s\" is %s."
@@ -244,7 +252,8 @@ The order of elements matters: whichever one matches first is applied."
              perc
              (unless (seq-some (lambda (s) (string= perc s))
                                '("Top" "Bot" "All"))
-                "%%%%")))))
+                "%%%%")
+              " "))))
 (defun +modeline-file-percentage-icon (&optional spacer)
  "Display the position in the current file as an icon."
@@ -312,7 +321,8 @@ to a function in the current buffer, call that function instead."
               +modeline-position-function
             (+modeline-concat '(+modeline-region
                                 +modeline-line-column
-                                 +modeline-file-percentage)))))
+                                 ;; +modeline-file-percentage
+                                 )))))
 (defun +modeline-vc (&optional spacer)
  "Display the version control branch of the current buffer in the modeline."
author	Case Duckworth	2022-05-05 18:41:42 -0500
committer	Case Duckworth	2022-05-05 18:41:42 -0500
commit	f0febf681490412709be7b494232de8c41253769 (patch)
tree	80e678d98f2496aa668caee22ad6b3276bcaa27f /lisp
parent	meh (diff)
download	emacs-f0febf681490412709be7b494232de8c41253769.tar.gz emacs-f0febf681490412709be7b494232de8c41253769.zip

diff --git a/lisp/+Info.el b/lisp/+Info.el index a3c2fcd..46bd5f8 100644 --- a/lisp/+Info.el +++ b/lisp/+Info.el
@@ -13,5 +13,72 @@ arg reversed."
13	(interactive "P" Info-mode)	13	(interactive "P" Info-mode)
14	(Info-copy-current-node-name (unless arg 0)))	14	(Info-copy-current-node-name (unless arg 0)))
15		15
		16	(defun +Info-modeline-breadcrumbs ()
		17	(let ((nodes (Info-toc-nodes Info-current-file))
		18	(node Info-current-node)
		19	(crumbs ())
		20	(depth Info-breadcrumbs-depth-internal)
		21	(text ""))
		22	;; Get ancestors from the cached parent-children node info
		23	(while (and (not (equal "Top" node)) (> depth 0))
		24	(setq node (nth 1 (assoc node nodes)))
		25	(when node (push node crumbs))
		26	(setq depth (1- depth)))
		27	;; Add bottom node.
		28	(setq crumbs (nconc crumbs (list Info-current-node)))
		29	(when crumbs
		30	;; Add top node (and continuation if needed).
		31	(setq crumbs (cons "Top" (if (member (pop crumbs) '(nil "Top"))
		32	crumbs
		33	(cons nil crumbs))))
		34	(dolist (node crumbs)
		35	(let ((crumbs-map (make-sparse-keymap))
		36	(menu-map (make-sparse-keymap "Breadcrumbs in Mode Line")))
		37	(define-key crumbs-map [mode-line mouse-3] menu-map)
		38	(when node
		39	(define-key menu-map [Info-prev]
		40	`(menu-item "Previous Node" Info-prev
		41	:visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node"))
		42	(define-key menu-map [Info-next]
		43	`(menu-item "Next Node" Info-next
		44	:visible ,(Info-check-pointer "next") :help "Go to the next node"))
		45	(define-key menu-map [separator] '("--"))
		46	(define-key menu-map [Info-breadcrumbs-in-mode-line-mode]
		47	`(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode
		48	:help "Toggle displaying breadcrumbs in the Info mode-line"
		49	:button (:toggle . Info-breadcrumbs-in-mode-line-mode)))
		50	(define-key menu-map [Info-set-breadcrumbs-depth]
		51	`(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth
		52	:help "Set depth of breadcrumbs to show in the mode-line"))
		53	(setq node (if (equal node Info-current-node)
		54	(propertize
		55	(replace-regexp-in-string "%" "%%" Info-current-node)
		56	'face 'mode-line-buffer-id
		57	'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu"
		58	'mouse-face 'mode-line-highlight
		59	'local-map
		60	(progn
		61	(define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down)
		62	(define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up)
		63	crumbs-map))
		64	(propertize
		65	node
		66	'local-map (progn (define-key crumbs-map [mode-line mouse-1]
		67	`(lambda () (interactive) (Info-goto-node ,node)))
		68	(define-key crumbs-map [mode-line mouse-2]
		69	`(lambda () (interactive) (Info-goto-node ,node)))
		70	crumbs-map)
		71	'mouse-face 'mode-line-highlight
		72	'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu")))))
		73	(let ((nodetext (if (not (equal node "Top"))
		74	node
		75	(concat (format "(%s)" (if (stringp Info-current-file)
		76	(file-name-nondirectory Info-current-file)
		77	;; Some legacy code can still use a symbol.
		78	Info-current-file))
		79	node))))
		80	(setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "...")))))
		81	text)))
		82
16	(provide '+Info)	83	(provide '+Info)
17	;;; +Info.el ends here	84	;;; +Info.el ends here


diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 3a922e3..e5b5bc6 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el
@@ -72,26 +72,34 @@ and appended with `truncate-string-ellipsis'."
72	(natnum :tag "Number of characters")	72	(natnum :tag "Number of characters")
73	(float :tag "Fraction of window's width")))	73	(float :tag "Fraction of window's width")))
74		74
		75	(defcustom +modeline-buffer-position nil
		76	"What to put in the `+modeline-buffer-name' position."
		77	:type 'function
		78	:local t)
		79
75	(defun +modeline-buffer-name (&optional spacer) ; gonsie	80	(defun +modeline-buffer-name (&optional spacer) ; gonsie
76	"Display the buffer name."	81	"Display the buffer name."
77	(let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))	82	(let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))
78	(concat (or spacer +modeline-default-spacer)	83	(concat (or spacer +modeline-default-spacer)
79	(propertize (cond	84	(if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
80	((ignore-errors	85	(funcall +modeline-buffer-position)
81	(and (> +modeline-buffer-name-max-length 0)	86	(propertize (cond
82	(< +modeline-buffer-name-max-length 1)))	87	((ignore-errors
83	(truncate-string-to-width bufname	88	(and (> +modeline-buffer-name-max-length 0)
84	(* (window-total-width) +modeline-buffer-name-max-length)	89	(< +modeline-buffer-name-max-length 1)))
85	nil nil t))	90	(truncate-string-to-width bufname
86	((ignore-errors	91	(* (window-total-width)
87	(> +modeline-buffer-name-max-length 1))	92	+modeline-buffer-name-max-length)
88	(truncate-string-to-width bufname	93	nil nil t))
89	+modeline-buffer-name-max-length	94	((ignore-errors
90	nil nil t))	95	(> +modeline-buffer-name-max-length 1))
91	(t bufname))	96	(truncate-string-to-width bufname
92	'help-echo (or (buffer-file-name)	97	+modeline-buffer-name-max-length
93	(buffer-name))	98	nil nil t))
94	'mouse-face 'mode-line-highlight))))	99	(t bufname))
		100	'help-echo (or (buffer-file-name)
		101	(buffer-name))
		102	'mouse-face 'mode-line-highlight)))))
95		103
96	(defcustom +modeline-minions-icon "&"	104	(defcustom +modeline-minions-icon "&"
97	"The \"icon\" for `+modeline-minions' button."	105	"The \"icon\" for `+modeline-minions' button."
@@ -152,17 +160,17 @@ The order of elements matters: whichever one matches first is applied."
152	(defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified'	160	(defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified'
153	"Display a color-coded \"icon\" indicator for the buffer's status."	161	"Display a color-coded \"icon\" indicator for the buffer's status."
154	(let* ((icon (catch :icon	162	(let* ((icon (catch :icon
155	(dolist (cell +modeline-modified-icon-alist)	163	(dolist (cell +modeline-modified-icon-alist)
156	(when (pcase (car cell)	164	(when (pcase (car cell)
157	('ephemeral (not (buffer-file-name)))	165	('ephemeral (not (buffer-file-name)))
158	('readonly buffer-read-only)	166	('readonly buffer-read-only)
159	('modified (buffer-modified-p))	167	('modified (buffer-modified-p))
160	('special	168	('special
161	(apply 'derived-mode-p	169	(apply 'derived-mode-p
162	+modeline-modified-icon-special-modes))	170	+modeline-modified-icon-special-modes))
163	('t t)	171	('t t)
164	(_ nil))	172	(_ nil))
165	(throw :icon cell))))))	173	(throw :icon cell))))))
166	(concat (or spacer +modeline-default-spacer)	174	(concat (or spacer +modeline-default-spacer)
167	(propertize (or (cdr-safe icon) "")	175	(propertize (or (cdr-safe icon) "")
168	'help-echo (format "Buffer \"%s\" is %s."	176	'help-echo (format "Buffer \"%s\" is %s."
@@ -244,7 +252,8 @@ The order of elements matters: whichever one matches first is applied."
244	perc	252	perc
245	(unless (seq-some (lambda (s) (string= perc s))	253	(unless (seq-some (lambda (s) (string= perc s))
246	'("Top" "Bot" "All"))	254	'("Top" "Bot" "All"))
247	"%%%%")))))	255	"%%%%")
		256	" "))))
248		257
249	(defun +modeline-file-percentage-icon (&optional spacer)	258	(defun +modeline-file-percentage-icon (&optional spacer)
250	"Display the position in the current file as an icon."	259	"Display the position in the current file as an icon."
@@ -312,7 +321,8 @@ to a function in the current buffer, call that function instead."
312	+modeline-position-function	321	+modeline-position-function
313	(+modeline-concat '(+modeline-region	322	(+modeline-concat '(+modeline-region
314	+modeline-line-column	323	+modeline-line-column
315	+modeline-file-percentage)))))	324	;; +modeline-file-percentage
		325	)))))
316		326
317	(defun +modeline-vc (&optional spacer)	327	(defun +modeline-vc (&optional spacer)
318	"Display the version control branch of the current buffer in the modeline."	328	"Display the version control branch of the current buffer in the modeline."