emacs-btap

Emacs library to browse thing at point
Log | Files | Refs

emacs-btap.el (4816B)

      1 ;;; -*- lexical-binding: t -*-
      2 ;;;
      3 ;;; emacs-btap.el
      4 ;;;
      5 ;;; Browse thing at point.
      6 ;;;
      7 ;;; Copyright (C) 2020--2025 Tomas Hlavaty <tom at logand dot com>
      8 ;;;
      9 ;;; License: GPLv3 or later
     10 ;;;
     11 ;;; Download: git clone https://logand.com/git/emacs-btap.git
     12 ;;;
     13 ;;; Configuration:
     14 ;;;
     15 ;;;   (add-to-list 'load-path "~/git/emacs-btap")
     16 ;;;   (require 'emacs-btap)
     17 ;;;   (global-set-key "\M-f" 'btap)
     18 ;;;
     19 ;;;   To see customizable variables, evaluate: (occur "defcustom")
     20 ;;;
     21 ;;; Usage:
     22 ;;;
     23 ;;;   M-x btap will browse the thing at point.
     24 ;;;
     25 ;;; Examples:
     26 ;;;
     27 ;;;   To see a few examples, evaluate: (occur "example:")
     28 
     29 (require 'browse-url)
     30 (require 'thingatpt)
     31 (require 'files)
     32 
     33 (defcustom btap-try-functions '(
     34                                 ;; global
     35                                 btap-try-notmuch
     36                                 btap-try-man
     37                                 btap-try-url
     38                                 btap-try-file
     39                                 btap-try-clhs
     40                                 btap-try-emacs-bug
     41                                 btap-try-sbcl-bug
     42                                 ;; mode specific
     43                                 btap-try-cc-mode
     44                                 btap-try-lisp-mode
     45                                 ;; nothing matched
     46                                 btap-try-missing
     47                                 )
     48   "List of functions to try to handle btap action.
     49 Functions accept optional string argument and should return nil if not
     50 applicable for the given string.  If no string is given, the function
     51 should guess from the thing at point.  The first applicable function
     52 handles the btap action."
     53   :type '(repeat symbol)
     54   :group 'btap)
     55 
     56 (defun btap-url-at-point (&optional extra-uri-schemes)
     57   (let ((thing-at-point-uri-schemes
     58          (append extra-uri-schemes thing-at-point-uri-schemes)))
     59     (thing-at-point 'url t)))
     60 
     61 (defun btap-file-at-point ()
     62   (thing-at-point 'existing-filename t))
     63 
     64 (defun btap-regexp-at-point (regexp distance)
     65   (let ((x (thing-at-point-looking-at regexp distance)))
     66     (when x
     67       (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
     68 
     69 (defun btap-symbol-at-point ()
     70   (thing-at-point 'symbol t))
     71 
     72 (defun btap-try-notmuch (&optional string)
     73   (when (fboundp 'notmuch-show)
     74     (let ((x (or string (btap-url-at-point '("id:")))))
     75       (when (and x (string-match "^id:" x))
     76         (funcall 'notmuch-show x)
     77         x))))
     78 ;; example: id:87wncxxjv7.fsf@gnus.org
     79 
     80 (defun btap-try-man (&optional string)
     81   (when browse-url-man-function
     82     (let ((x (or string (btap-url-at-point '("man:")))))
     83       (when (and x (string-match "^man:" x))
     84         (funcall browse-url-man-function x)
     85         x))))
     86 ;; example: man:printf
     87 
     88 (defun btap-try-url (&optional string)
     89   (let ((x (or string (btap-url-at-point))))
     90     (when x
     91       (browse-url x)
     92       x)))
     93 ;; example: https://logand.com
     94 
     95 (defun btap-try-cc-mode (&optional string)
     96   (when (and (boundp 'c-buffer-is-cc-mode)
     97              c-buffer-is-cc-mode)
     98     (let ((x (or string (btap-regexp-at-point (rx bow (+ (any "0-9a-zA-Z_")) eow) 30))))
     99       (when x
    100         ;; TODO includes e.g. limits.h
    101         (btap-try-man (concat "man:" x))))))
    102 
    103 (defun btap-try-file (&optional string)
    104   (let ((x (or string (btap-file-at-point))))
    105     (when x
    106       (find-file (expand-file-name x))
    107       x)))
    108 ;; example: ~/.emacs
    109 ;; example: ~/.emacs.d
    110 
    111 (defun btap-try-clhs (&optional string)
    112   (when (fboundp 'hyperspec-lookup)
    113     (let ((x (or string (btap-url-at-point '("clhs:")))))
    114       (when (and x (string-match "^clhs:" x))
    115         (funcall 'hyperspec-lookup (substring x 5))
    116         x))))
    117 ;; example: clhs:delete-if
    118 
    119 (defun btap-try-lisp-mode (&optional string)
    120   (when (and (fboundp 'hyperspec-lookup)
    121              (eq major-mode 'lisp-mode))
    122     (let ((x (or string (btap-symbol-at-point))))
    123       (when x
    124         (funcall 'hyperspec-lookup x)
    125         x))))
    126 
    127 (defun btap-try-emacs-bug (&optional string)
    128   (let ((x (or string (btap-regexp-at-point (rx bow "bug#" (+ digit) eow) 10))))
    129     (when (and x (string-match "^bug#" x))
    130       (btap-try-url (concat "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=" (substring x 4))))))
    131 ;; example: bug#36649
    132 
    133 (defun btap-try-sbcl-bug (&optional string)
    134   (let ((x (or string (btap-regexp-at-point (rx bow "lp#" (+ digit) eow) 10))))
    135     (when (and x (string-match "^lp#" x))
    136       (btap-try-url (concat "https://bugs.launchpad.net/bugs/" (substring x 3))))))
    137 ;; example: lp#1903901
    138 
    139 (defun btap-try-missing ()
    140   (signal 'btap-try-missing (list "Nothing at point to browse")))
    141 ;; example: /does-not-exist
    142 
    143 (defun btap ()
    144   "Browse thing at point.  See also the variable `btap-try-functions'."
    145   (interactive)
    146   (let (z
    147         (x btap-try-functions))
    148     (while (and x (not (setq z (funcall (pop x))))))
    149     z))
    150 
    151 (provide 'emacs-btap)