emacs-btap

emacs-btap.el (5096B)

---

 ;;; -*- 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:
 ;;;
 ;;; (add-to-list 'load-path "~/git/emacs-btap")
 ;;; (require 'emacs-btap)
 ;;; (global-set-key "\M-f" 'btap)
 ;;;
 ;;; Example usage:
 ;;;
 ;;; M-x btap will browse the thing at point.
 ;;;
 ;;; Some variables can be customized in the btap group.
 ;;;
 ;;; To see a few examples, evaluate: (occur "example:")
 
 (require 'browse-url)
 (require 'cl-lib)
 (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))))
 ;; example: man:printf
 
 (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)))))))
 ;; example: https://logand.com
 
 (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)))))))
 ;; example: ~/.emacs
 ;; example: ~/.emacs.d
 
 (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))))
 ;; example: clhs:delete-if
 
 (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))))))
 ;; example: lp#1903901
 
 (defun btap-try-missing ()
   (signal 'btap-try-missing (list "Nothing at point to browse")))
 ;; example: /does-not-exist
 
 (defun btap--memoize-thunk (thunk)
   (let (z)
     (lambda ()
       (when thunk
         (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 'emacs-btap)