commit 7e9a4881667d15b7eebf57c59c19836c3a5e2ff4 parent af8f8cc16735b1f67ee5bbacd7ef465b83aa7053 Author: Tomas Hlavaty <tom@logand.com> Date: Thu, 31 Dec 2020 15:44:51 +0100 start Diffstat:
| A | emacs-btap.el | | | 152 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 152 insertions(+), 0 deletions(-)
diff --git a/emacs-btap.el b/emacs-btap.el @@ -0,0 +1,152 @@ +;;; -*- lexical-binding: t -*- +;;; +;;; emacs-btap.el +;;; +;;; Browse thing at point. +;;; +;;; Copyright (C) 2020 Tomas Hlavaty <tom at logand dot com> +;;; +;;; License: GPLv3 or later +;;; +;;; Download: git clone https://logand.com/git/emacs-btap.git +;;; +;;; Example configuration: +;;; +;;; (require 'btap) +;;; +;;; Example usage: +;;; +;;; M-x btap will browse the thing at point. +;;; +;;; Some variables can be customized in the btap group. + +(require 'browse-url) +(require 'cl) +(require 'ffap) +(require 'thingatpt) + +(defcustom btap-try-functions '( + ;; global + btap-try-notmuch + btap-try-man + btap-try-url + btap-try-file + btap-try-wild-file + btap-try-clhs + btap-try-sbcl-bug + ;; mode specific + btap-try-cc-mode + btap-try-lisp-mode + ;; nothing matched + btap-try-missing + ) + "List of functions to try to handle btap action. +Functions accept optional string argument and should return nil if not +applicable for the given string. If no string is given, the function +should guess from the thing at point. The first applicable function +handles the btap action." + :type '(repeat symbol) + :group 'btap) + +(defvar btap--ffap-guesser-thunk) +(defun btap-ffap-guesser () + (funcall btap--ffap-guesser-thunk)) + +(defun btap-try-notmuch (&optional string) + (when (fboundp 'notmuch-show) + (let ((x (or string (btap-ffap-guesser)))) + (when (and x (string-match "^id:" x)) + (funcall 'notmuch-show x) + x)))) + +(defun btap-try-man (&optional string) + (when browse-url-man-function + (let ((x (or string (btap-ffap-guesser)))) + (when (and x (string-match "^man:" x)) + (funcall browse-url-man-function x) + x)))) + +(defun btap-try-url (&optional string) + (when ffap-url-fetcher + (let ((x (or string (btap-ffap-guesser)))) + (when x + (let ((url (ffap-url-p x))) + (when url + (let (current-prefix-arg) + (funcall ffap-url-fetcher url) + url))))))) + +(defun btap-try-cc-mode (&optional string) + (when (and (boundp 'c-buffer-is-cc-mode) + c-buffer-is-cc-mode) + (let ((x (or string (thing-at-point 'word t)))) + (when x + ;; TODO includes e.g. limits.h + (btap-try-man (concat "man:" x)))))) + +(defun btap-try-file (&optional string) + (when ffap-file-finder + (let ((x (or string (btap-ffap-guesser)))) + (when x + (let ((url (ffap-url-p x))) + (unless url + (when (file-exists-p x) + (funcall ffap-file-finder (expand-file-name x)) + x))))))) + +(defun btap-try-wild-file (&optional string) + (when (and ffap-dired-wildcards + find-file-wildcards + ffap-file-finder) + (let ((x (or string (btap-ffap-guesser)))) + (when x + (let ((url (ffap-url-p x))) + (unless url + (when (and (string-match ffap-dired-wildcards x) + ;; Check if it's find-file that supports wildcards arg + (memq ffap-file-finder '(find-file find-alternate-file))) + (funcall ffap-file-finder (expand-file-name x) t) + x))))))) + +(defun btap-try-clhs (&optional string) + (when (fboundp 'hyperspec-lookup) + (let ((x (or string (btap-ffap-guesser)))) + (when (and x (string-match "^clhs:" x)) + (funcall 'hyperspec-lookup (substring x 5)) + x)))) + +(defun btap-try-lisp-mode (&optional string) + (when (and (fboundp 'hyperspec-lookup) + (eq major-mode 'lisp-mode)) + (let ((x (or string (thing-at-point 'word t)))) ;; TODO include - etc + (when x + (funcall 'hyperspec-lookup x) + x)))) + +(defun btap-try-sbcl-bug (&optional string) + (let ((x (or string (thing-at-point 'filename t)))) + (when (and x (string-match "^lp#" x)) + (btap-try-url (concat "https://bugs.launchpad.net/bugs/" (substring x 3)))))) + +(defun btap-try-missing () + (signal 'btap-try-missing (list "Nothing at point to browse"))) + +(let ((void (list nil))) + (defun btap--memoize-thunk (thunk) + (let ((z void)) + (lambda () + (when (eq z void) + (setq z (funcall thunk) + thunk nil)) + z)))) + +(defun btap () + "Browse thing at point. See also the variable `btap-try-functions'." + (interactive) + (let (z + (btap--ffap-guesser-thunk (btap--memoize-thunk 'ffap-guesser)) + (x btap-try-functions)) + (while (and x (not (setq z (funcall (pop x)))))) + z)) + +(provide 'btap)