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

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

  (let ((things autobm-try-thingatpt-things) name)

    (while (and things (not name))

      (setq name (thing-at-point (car things)))

      (setq things (cdr things)))

    name))

(defun autobm-get-active-handlers ()

  (let ( h handlers (modes (list t)) )

    (dolist (m minor-mode-list)

      (when (and (boundp m) (symbol-value m))

        (push m modes)))

    (push major-mode 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)