Merge branch 'main' of tildegit.org:acdw/emacs

3 files changed, 107 insertions, 31 deletions

@@ -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
@@ -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
-                         ((ignore-errors
-                            (and (> +modeline-buffer-name-max-length 0)
-                                 (< +modeline-buffer-name-max-length 1)))
-                          (truncate-string-to-width bufname
-                                                    (* (window-total-width) +modeline-buffer-name-max-length)
-                                                    nil nil t))
-                         ((ignore-errors
-                            (> +modeline-buffer-name-max-length 1))
-                          (truncate-string-to-width bufname
-                                                    +modeline-buffer-name-max-length
-                                                    nil nil t))
-                         (t bufname))
-                        'help-echo (or (buffer-file-name)
-                                       (buffer-name))
-                        'mouse-face 'mode-line-highlight))))
+            (if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
+                (funcall +modeline-buffer-position)
+              (propertize (cond
+                           ((ignore-errors
+                              (and (> +modeline-buffer-name-max-length 0)
+                                   (< +modeline-buffer-name-max-length 1)))
+                            (truncate-string-to-width bufname
+                                                      (* (window-total-width)
+                                                         +modeline-buffer-name-max-length)
+                                                      nil nil t))
+                           ((ignore-errors
+                              (> +modeline-buffer-name-max-length 1))
+                            (truncate-string-to-width bufname
+                                                      +modeline-buffer-name-max-length
+                                                      nil nil t))
+                           (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)
-                  (when (pcase (car cell)
-                          ('ephemeral (not (buffer-file-name)))
-                          ('readonly buffer-read-only)
-                          ('modified (buffer-modified-p))
-                          ('special
-                           (apply 'derived-mode-p
-                                  +modeline-modified-icon-special-modes))
-                          ('t t)
-                          (_ nil))
-                    (throw :icon cell))))))
+                 (dolist (cell +modeline-modified-icon-alist)
+                   (when (pcase (car cell)
+                           ('ephemeral (not (buffer-file-name)))
+                           ('readonly buffer-read-only)
+                           ('modified (buffer-modified-p))
+                           ('special
+                            (apply 'derived-mode-p
+                                   +modeline-modified-icon-special-modes))
+                           ('t t)
+                           (_ nil))
+                     (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."
@@ -107,8 +107,7 @@ on buffers derived from one of the modes in PREDICATE."
   (let ((pred (or predicate t)))
     (dolist (buf (buffer-list))
       (with-current-buffer buf
-        (when (cond ((or (eq (car-safe pred) 'closure)
-                         (fboundp pred))
+        (when (cond ((functionp pred)
                      (funcall pred))
                     ((listp pred)
                      (apply #'derived-mode-p pred))