--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/mylisp/autobm.el Sat Jan 02 00:33:04 2021 +0200
@@ -0,0 +1,84 @@
+;;; autobm.el --- suggest bookmark name from local context -*- lexical-binding: t -*-
+
+(require 'cl-lib)
+(require 'bookmark)
+(require 'which-func)
+(require 'semantic/find)
+
+(defvar autobm-mode-handlers
+ '((emacs-lisp-mode . (autobm-try-semantic))
+ (semantic-decoration-mode . (autobm-try-semantic))
+ (rst-mode . (autobm-try-word))
+ (t . (autobm-try-which-func autobm-try-thingatpt)))
+ "Alist of handlers by mode. Key is a mojor or minor mode name, or `t' as fallback.
+Value is a no-argument function or a list of such functions,
+which returns string or `nil'.")
+
+(defun autobm-try-which-func ()
+ (which-function))
+
+(defvar autobm-try-thingatpt-things
+ '(symbol url email))
+
+(defun autobm-try-thingatpt ()
+ (cl-some #'thing-at-point autobm-try-thingatpt-things))
+
+(defun autobm-try-word ()
+ (thing-at-point 'word))
+
+(defun autobm-try-line ()
+ (let ( (line (thing-at-point 'line)) )
+ (substring line 0 (min (1- (length line)) 30))))
+
+(defun autobm-get-active-handlers ()
+ (let ( h handlers (modes (list major-mode)) )
+ (dolist (m minor-mode-list)
+ (when (and (boundp m) (symbol-value m))
+ (push m modes)))
+ (push t modes)
+ (dolist (m modes)
+ (setq h (assoc m autobm-mode-handlers))
+ (when h
+ (setq h (cdr h))
+ (cond
+ ((symbolp h)
+ (push h handlers))
+ ((listp h)
+ (setq handlers (append h handlers)))
+ (t (error "autobm-mode-handlers isn't a list or a symbol")))))
+ handlers))
+
+(defvar autobm-try-semantic-type-alist
+ '((variable . "var")
+ (function . "fn")
+ (type . "type")))
+
+(defun autobm-try-semantic ()
+ (let ( (tag (semantic-current-tag)) prefix )
+ (when tag
+ (setq prefix (assoc (cadr tag) autobm-try-semantic-type-alist))
+ (when prefix
+ (format "%s: %s" (cdr prefix) (car tag))))))
+
+(defun autobm-suggest ()
+ "Suggest bookmark name depending on buffer mode and local
+context using `autobm-try-semantic-type-alist'. First checked major
+mode then active minor modes."
+ (let ((result nil))
+ (catch 'exit
+ (dolist (h (autobm-get-active-handlers))
+ (when (setq result (funcall h))
+ (throw 'exit result))))))
+
+;;;###autoload
+(defun autobm (&optional no-overwrite)
+ (interactive "P")
+ (let ( (name (autobm-suggest)) )
+ (when name
+ (setq name (read-string "Set bookmark: " name bookmark-minibuffer-read-name-map name)))
+ (bookmark-set name no-overwrite)))
+
+;; (global-set-key (kbd "C-x r m") 'autobm)
+
+(provide 'autobm)
+