summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-05-05 18:41:42 -0500
committerCase Duckworth2022-05-05 18:41:42 -0500
commitf0febf681490412709be7b494232de8c41253769 (patch)
tree80e678d98f2496aa668caee22ad6b3276bcaa27f /lisp
parentmeh (diff)
downloademacs-f0febf681490412709be7b494232de8c41253769.tar.gz
emacs-f0febf681490412709be7b494232de8c41253769.zip
Change modeline
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+Info.el67
-rw-r--r--lisp/+modeline.el68
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."
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."