;;; autobm.el --- suggest bookmark name from local context

(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))
    (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-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-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)