autobm.el
changeset 1666 06937ff1ec5f
parent 1665 3685e2321a9b
child 1667 7f70095fbf32
equal deleted inserted replaced
1665:3685e2321a9b 1666:06937ff1ec5f
     1 ;;; autobm.el --- suggest bookmark name from local context -*- lexical-binding: t -*-
       
     2 
       
     3 (require 'cl-lib)
       
     4 (require 'bookmark)
       
     5 (require 'which-func)
       
     6 (require 'semantic/find)
       
     7 
       
     8 (defvar autobm-mode-handlers
       
     9   '((emacs-lisp-mode . (autobm-try-semantic))
       
    10     (semantic-decoration-mode . (autobm-try-semantic))
       
    11     (rst-mode . (autobm-try-word))
       
    12     (t . (autobm-try-which-func autobm-try-thingatpt)))
       
    13   "Alist of handlers by mode. Key is a mojor or minor mode name, or `t' as fallback.
       
    14 Value is a no-argument function or a list of such functions,
       
    15 which returns string or `nil'.")
       
    16 
       
    17 (defun autobm-try-which-func ()
       
    18   (which-function))
       
    19 
       
    20 (defvar autobm-try-thingatpt-things
       
    21   '(symbol url email))
       
    22 
       
    23 (defun autobm-try-thingatpt ()
       
    24   (cl-some #'thing-at-point autobm-try-thingatpt-things))
       
    25 
       
    26 (defun autobm-try-word ()
       
    27   (thing-at-point 'word))
       
    28 
       
    29 (defun autobm-try-line ()
       
    30   (let ( (line (thing-at-point 'line)) )
       
    31     (substring line 0 (min (1- (length line)) 30))))
       
    32 
       
    33 (defun autobm-get-active-handlers ()
       
    34   (let ( h handlers (modes (list major-mode)) )
       
    35     (dolist (m minor-mode-list)
       
    36       (when (and (boundp m) (symbol-value m))
       
    37         (push m modes)))
       
    38     (push t modes)
       
    39     (dolist (m modes)
       
    40       (setq h (assoc m autobm-mode-handlers))
       
    41       (when h
       
    42         (setq h (cdr h))
       
    43         (cond
       
    44          ((symbolp h)
       
    45           (push h handlers))
       
    46          ((listp h)
       
    47           (setq handlers (append h handlers)))
       
    48          (t (error "autobm-mode-handlers isn't a list or a symbol")))))
       
    49     handlers))
       
    50 
       
    51 (defvar autobm-try-semantic-type-alist
       
    52   '((variable . "var")
       
    53     (function . "fn")
       
    54     (type . "type")))
       
    55 
       
    56 (defun autobm-try-semantic ()
       
    57   (let ( (tag (semantic-current-tag)) prefix )
       
    58     (when tag
       
    59       (setq prefix (assoc (cadr tag) autobm-try-semantic-type-alist))
       
    60       (when prefix
       
    61         (format "%s: %s" (cdr prefix) (car tag))))))
       
    62 
       
    63 (defun autobm-suggest ()
       
    64   "Suggest bookmark name depending on buffer mode and local
       
    65 context using `autobm-try-semantic-type-alist'. First checked major
       
    66 mode then active minor modes."
       
    67   (let ((result  nil))
       
    68     (catch 'exit
       
    69       (dolist (h (autobm-get-active-handlers))
       
    70         (when (setq result (funcall h))
       
    71           (throw 'exit result))))))
       
    72 
       
    73 ;;;###autoload
       
    74 (defun autobm (&optional no-overwrite)
       
    75   (interactive "P")
       
    76   (let ( (name (autobm-suggest)) )
       
    77     (when name
       
    78       (setq name (read-string "Set bookmark: " name bookmark-minibuffer-read-name-map name)))
       
    79     (bookmark-set name no-overwrite)))
       
    80 
       
    81 ;; (global-set-key (kbd "C-x r m") 'autobm)
       
    82 
       
    83 (provide 'autobm)
       
    84