Subject: bug#54030: 29.0.50; [PATCH] Extend bookmark menu with column displaying handler type

From: Matthias Meulien <[email-masked]>
Date: Wed, 16 Feb 2022 20:55:35 +0100

This is a feature request.

Bookmarks handled by VC (through `vc-dir-bookmark-make-record') are
named after the VC directory prefixed by the name of the VC backend
(with parentheses).  Thus when one use a single VC backend, eg Git, all
bookmarks handled by VC start with "(Git) " which makes the sort of
bookmarks by name in bookmark menu useless.

I suggest to remove that prefix but extend the bookmark menu with a new
column "Type" displaying the type of bookmark handler.  As a result
sorting bookmarks by their name don't gather bookmarks handled by VC
anymore.

Example:

becomes with the proposed patches:

Patch are attached. Note that at present time there's no way to filter
bookmarks by type, but I may add this feature if people are interested.

>From cc3aaba731c08e8e2af6a97d69ab70052bf12137 Mon Sep 17 00:00:00 2001
From: Matthias Meulien <[email-masked]>
Date: Tue, 15 Feb 2022 23:39:02 +0100
Subject: [PATCH 1/2] Extend bookmark menu with with handler type column

* lisp/bookmark.el (bookmark-bmenu--revert): Extend table entries with
handler type.
(bookmark-bmenu-mode): Add handler type column.
* lisp/doc-view.el (doc-view-bookmark-jump): Set bookmark handler type.
* lisp/help-mode.el (help-bookmark-jump): Set bookmark handler type.
* lisp/image-dired.el (image-dired-bookmark-jump): Set bookmark handler type.
* lisp/info.el (Info-bookmark-jump): Set bookmark handler type.
* lisp/net/eww.el (eww-bookmark-jump): Set bookmark handler type.
* lisp/vc/vc-dir.el (vc-dir-bookmark-jump): Set bookmark handler type.
* lisp/woman.el (woman-bookmark-jump): Set bookmark handler type.
---
 lisp/bookmark.el    | 19 ++++++++++++++++++-
 lisp/doc-view.el    |  2 ++
 lisp/help-mode.el   |  1 +
 lisp/image-dired.el |  1 +
 lisp/info.el        |  1 +
 lisp/net/eww.el     |  2 ++
 lisp/vc/vc-dir.el   |  2 ++
 lisp/woman.el       |  2 ++
 8 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 8753326881..61c532c1f3 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -344,6 +344,17 @@ bookmark-name-from-full-record
 BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'."
   (car bookmark-record))
 
+(defun bookmark-type-from-full-record (bookmark-record)
+  "Return then type of BOOKMARK-RECORD.
+BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's
+type is read from the symbol property named
+`bookmark-handler-type' read on the record handler function."
+  (let ((handler (bookmark-get-handler bookmark-record)))
+    (when (autoloadp (symbol-function handler))
+      (autoload-do-load (symbol-function handler)))
+    (if (symbolp handler)
+        (get handler 'bookmark-handler-type)
+     "")))
 
 (defun bookmark-all-names ()
   "Return a list of all current bookmark names."
@@ -1351,7 +1362,6 @@ bookmark-location
       (bookmark-get-filename bookmark-name-or-record)
       "-- Unknown location --"))
 
-
 ;;;###autoload
 (defun bookmark-rename (old-name &optional new-name)
   "Change the name of OLD-NAME bookmark to NEW-NAME name.
@@ -1790,6 +1800,7 @@ bookmark-bmenu--revert
   (let (entries)
     (dolist (full-record (bookmark-maybe-sort-alist))
       (let* ((name       (bookmark-name-from-full-record full-record))
+             (type       (bookmark-type-from-full-record full-record))
              (annotation (bookmark-get-annotation full-record))
              (location   (bookmark-location full-record)))
         (push (list
@@ -1803,6 +1814,7 @@ bookmark-bmenu--revert
                                   'follow-link t
                                   'help-echo "mouse-2: go to this bookmark in other window")
                     name)
+                 ,(or type "")
                  ,@(if bookmark-bmenu-toggle-filenames
                        (list location))])
               entries)))
@@ -1891,6 +1903,7 @@ bookmark-bmenu-mode
   (setq tabulated-list-format
         `[("" 1) ;; Space to add "*" for bookmark with annotation
           ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate)
+          ("Type" 15 bookmark-bmenu--type-predicate)
           ,@(if bookmark-bmenu-toggle-filenames
                 '(("File" 0 bookmark-bmenu--file-predicate)))])
   (setq tabulated-list-padding bookmark-bmenu-marks-width)
@@ -1905,6 +1918,10 @@ bookmark-bmenu--name-predicate
 This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
   (string< (caar a) (caar b)))
 
+(defun bookmark-bmenu--type-predicate (a b)
+  "Predicate to sort \"*Bookmark List*\" buffer by the type column.
+This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
+  (string< (elt (cadr a) 2) (elt (cadr b) 2)))
 
 (defun bookmark-bmenu--file-predicate (a b)
   "Predicate to sort \"*Bookmark List*\" buffer by the file column.
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 4979a2c0e2..193cf42ea4 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -2247,6 +2247,8 @@ doc-view-bookmark-jump
     (add-hook 'bookmark-after-jump-hook show-fn-sym)
     (bookmark-default-handler bmk)))
 
+(put 'doc-view-bookmark-jump 'bookmark-handler-type "Docview")
+
 ;; Obsolete.
 
 (defun doc-view-intersection (l1 l2)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 5fb5dcfb19..d1b9357f3c 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -936,6 +936,7 @@ help-bookmark-jump
     (pop-to-buffer "*Help*")
     (goto-char position)))
 
+(put 'help-bookmark-jump 'bookmark-handler-type "Help")
 
 (provide 'help-mode)
 
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 9b0bbb70df..d8bd2937db 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -2792,6 +2792,7 @@ image-dired-bookmark-jump
     ;; (bookmark-prop-get bookmark 'image-dired-file)
     (goto-char (point-min))))
 
+(put 'image-dired-bookmark-jump 'bookmark-handler-type "Image")
 
 ;;; Obsolete
 
diff --git a/lisp/info.el b/lisp/info.el
index bb8cd0d312..0565663c38 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -5449,6 +5449,7 @@ Info-bookmark-jump
     (bookmark-default-handler
      `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
 
+(put 'Info-bookmark-jump 'bookmark-handler-type "Info")
 
 ;;;###autoload
 (defun info-display-manual (manual)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index eaa5c11938..9db07b51db 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -2499,6 +2499,8 @@ eww-bookmark-jump
   "Default bookmark handler for EWW buffers."
   (eww (bookmark-prop-get bookmark 'location)))
 
+(put 'eww-bookmark-jump 'bookmark-handler-type "EWW")
+
 (provide 'eww)
 
 ;;; eww.el ends here
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index ba6e098d98..944b409ea2 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1560,6 +1560,8 @@ vc-dir-bookmark-jump
     (bookmark-default-handler
      `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
 
+(put 'vc-dir-bookmark-jump 'bookmark-handler-type "VC")
+
 
 (provide 'vc-dir)
 
diff --git a/lisp/woman.el b/lisp/woman.el
index e16785329a..c0c8f34348 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -4579,6 +4579,8 @@ woman-bookmark-jump
     (bookmark-default-handler
      `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))
 
+(put 'woman-bookmark-jump 'bookmark-handler-type "WoMan")
+
 ;; Obsolete.
 
 (defvar woman-version "0.551 (beta)" "WoMan version information.")
-- 
2.30.2

>From 0fcc61b89d093eb1219893edeab69c496d22e378 Mon Sep 17 00:00:00 2001
From: Matthias Meulien <[email-masked]>
Date: Wed, 16 Feb 2022 08:49:07 +0100
Subject: [PATCH 2/2] Don't prefix bookmark name with VC backend name

* lisp/vc/vc-dir.el (vc-dir-bookmark-make-record): Remove prefix from
bookmark name.
---
 lisp/vc/vc-dir.el | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 944b409ea2..0d750515c3 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1538,9 +1538,8 @@ vc-dir-bookmark-make-record
 This implements the `bookmark-make-record-function' type for
 `vc-dir' buffers."
   (let* ((bookmark-name
-          (concat "(" (symbol-name vc-dir-backend) ") "
-                  (file-name-nondirectory
-                   (directory-file-name default-directory))))
+          (file-name-nondirectory
+           (directory-file-name default-directory)))
          (defaults (list bookmark-name default-directory)))
     `(,bookmark-name
       ,@(bookmark-make-record-default 'no-file)
-- 
2.30.2

In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.24, cairo version 1.16.0)
 of 2022-02-14 built on carbon
Repository revision: d52d913fa032a6cd1b6422cbbd44169b318ca174
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Debian GNU/Linux 11 (bullseye)

Configured using:
 'configure --with-native-compilation'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES
NATIVE_COMP NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3
THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XPM GTK3 ZLIB

Important settings:
  value of $LANG: fr_FR.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Bookmark Menu

Minor modes in effect:
  hl-line-mode: t
  highlight-changes-visible-mode: t
  shell-dirtrack-mode: t
  minions-mode: t
  global-company-mode: t
  company-mode: t
  desktop-save-mode: t
  save-place-mode: t
  electric-pair-mode: t
  icomplete-mode: t
  global-so-long-mode: t
  global-auto-revert-mode: t
  auto-insert-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  show-paren-mode: t
  electric-layout-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tab-bar-mode: t
  file-name-shadow-mode: t
  context-menu-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  window-divider-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t

Load-path shadows:
/home/matthias/.config/emacs/elpa/transient-20220130.1941/transient hides /usr/local/share/emacs/29.0.50/lisp/transient
/home/matthias/.config/emacs/elpa/dictionary-20201001.1727/dictionary hides /usr/local/share/emacs/29.0.50/lisp/net/dictionary

Features:
(shadow emacsbug sendmail image-dired autoload lisp-mnt log-edit edebug
shortdoc dabbrev url-http url-gw url-cache url-auth view woman cl-print
apropos man misearch multi-isearch speedbar ezimage dframe pulse grep
help-fns radix-tree smerge-mode diff add-log log-view pcvs-util
sh-script executable mhtml-mode css-mode hideshow cap-words superword
subword js generic meson-mode smie conf-mode yaml-mode make-mode rng-xsd
xsd-regexp rng-cmpct rng-nxml rng-valid nxml-mode nxml-outln nxml-rap
sgml-mode facemenu rst sort gnus-cite smiley shr-color mm-archive
mail-extr textsec uni-scripts idna-mapping ucs-normalize uni-confusable
textsec-check gnus-async gnus-bcklg qp gnus-ml disp-table gnus-topic
nndraft nnmh nnfolder utf-7 epa-file gnutls network-stream nsm
gnus-agent gnus-srvr gnus-score score-mode nnvirtual gnus-msg gnus-cache
hl-line dired-aux whitespace vc-dir flyspell ox-odt rng-loc rng-uri
rng-parse rng-match rng-dt rng-util rng-pttrn nxml-parse nxml-ns
nxml-enc xmltok nxml-util ox-latex ox-icalendar org-agenda ox-html table
ox-ascii ox-publish ox goto-addr org-element avl-tree ol-eww eww xdg
url-queue mm-url ol-rmail ol-mhe ol-irc ol-info ol-gnus nnselect
gnus-art mm-uu mml2015 mm-view mml-smime smime dig gnus-sum shr
pixel-fill kinsoku svg dom ol-docview doc-view image-mode exif ol-bibtex
ol-bbdb ol-w3m ol-doi org-link-doi follow mule-util jka-compr python
bug-reference display-line-numbers hilit-chg vc-mtn vc-hg vc-bzr vc-src
vc-sccs vc-svn vc-cvs vc-rcs vc bash-completion shell eglot array
jsonrpc ert ewoc debug backtrace flymake-proc flymake compile imenu
company-oddmuse company-keywords company-etags etags fileloop generator
xref project company-gtags company-dabbrev-code company-dabbrev
company-files company-clang company-capf company-cmake company-semantic
company-template company-bbdb avoid minions company pcase carbon-custom
cus-edit cus-load gnus-demon nntp gnus-group gnus-undo gnus-start
gnus-dbus dbus xml gnus-cloud nnimap nnmail mail-source utf7 netrc
parse-time gnus-spec gnus-win nnoo gnus-int gnus-range message
yank-media rmc puny rfc822 mml mml-sec epa derived epg rfc6068
epg-config mm-decode mm-bodies mm-encode mail-parse rfc2231 rfc2047
rfc2045 ietf-drums mailabbrev gmm-utils mailheader gnus nnheader
gnus-util mail-utils range mm-util mail-prsvr wid-edit gnus-dired
dired-x dired dired-loaddefs org-capture org-refile org ob ob-tangle
ob-ref ob-lob ob-table ob-exp org-macro org-footnote org-src ob-comint
org-pcomplete pcomplete comint ansi-color ring org-list org-faces
org-entities org-version ob-emacs-lisp ob-core ob-eval org-table
oc-basic bibtex iso8601 time-date ol org-keys oc org-compat org-macs
org-loaddefs format-spec find-func cal-menu calendar cal-loaddefs
dictionary link connection advice markdown-mode edit-indirect color
thingatpt noutline outline skeleton find-file vc-git diff-mode
easy-mmode vc-dispatcher ispell comp comp-cstr warnings rx cl-extra
help-mode desktop frameset server bookmark text-property-search pp
saveplace elec-pair icomplete so-long autorevert filenotify autoinsert
cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine
cc-vars cc-defs generic-x face-remap proof-site proof-autoloads info
package browse-url url url-proxy url-privacy url-expand url-methods
url-history url-cookie url-domsuf url-util mailcap url-handlers
url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json map url-vars seq gv subr-x byte-opt bytecomp
byte-compile cconv cl-loaddefs cl-lib iso-transl tooltip eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite emoji-zwj charscript charprop case-table
epa-hook jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice
button loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit x multi-tty make-network-process
native-compile emacs)

Memory information:
((conses 16 1234632 143740)
 (symbols 48 44787 17)
 (strings 32 239868 12813)
 (string-bytes 1 9302463)
 (vectors 16 110937)
 (vector-slots 8 2819948 246391)
 (floats 8 736 1584)
 (intervals 56 30215 2743)
 (buffers 992 240))

-- 
Matthias