emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

feature/lookup: refactor lookup commands

Browse source 
And move online-lookup commands to separate file
This commit is contained in:
Henrik Lissner 2019-04-16 20:22:17 -04:00
parent e7e1383b08
commit 8a5af077a6
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
3 changed files with 142 additions and 151 deletions
Download patch file Download diff file Expand all files Collapse all files

221
modules/feature/lookup/autoload/lookup.el
View file

@ -1,11 +1,10 @@
;;; feature/lookup/autoload/lookup.el -*- lexical-binding: t; -*- ;;; feature/lookup/autoload/lookup.el -*- lexical-binding: t; -*-
(defvar +lookup--last-provider nil)
(defvar +lookup--handler-alist nil) (defvar +lookup--handler-alist nil)
;;;###autodef ;;;###autodef
(defun set-lookup-handlers! (modes &rest plist) (cl-defun set-lookup-handlers!
(modes &rest plist &key definition references documentation file xref-backend async)
"Define a jump target for major MODES. "Define a jump target for major MODES.
This overwrites previously defined handlers for MODES. If used on minor modes, This overwrites previously defined handlers for MODES. If used on minor modes,
@ -37,67 +36,43 @@ Otherwise, these properties are available to be set:
Indicates that the supplied handlers *after* this property are asynchronous. Indicates that the supplied handlers *after* this property are asynchronous.
Note: async handlers do not fall back to the default handlers, due to their Note: async handlers do not fall back to the default handlers, due to their
nature. To get around this, you must write specialized wrappers to wait for nature. To get around this, you must write specialized wrappers to wait for
the async response and return 'fallback. the async response and return 'fallback."
\(fn MODE-OR-MODES &key ASYNC DEFINITION REFERENCES DOCUMENTATION FILE XREF-BACKEND)"
(declare (indent defun)) (declare (indent defun))
(dolist (mode (doom-enlist modes)) (dolist (mode (doom-enlist modes))
(let ((hook (intern (format "%s-hook" mode))) (let ((hook (intern (format "%s-hook" mode)))
(fn (intern (format "+lookup|init-%s" mode)))) (fn (intern (format "+lookup|init-%s" mode))))
(cond ((null (car plist)) (cond ((null (car plist))
(remove-hook hook fn) (remove-hook hook fn)
(setq +lookup--handler-alist (delq! mode +lookup--handler-alist 'assq)
(delq (assq mode +lookup--handler-alist)
+lookup--handler-alist))
(unintern fn nil)) (unintern fn nil))
((let ((old-plist (cdr (assq mode +lookup--handler-alist))) ((fset fn
async)
(while plist
(let ((prop (pop plist))
(fns (pop plist)))
(if (eq prop :async)
(setq async t)
(dolist (fn (doom-enlist fns))
(put fn '+lookup-async async))
(setq old-plist (plist-put old-plist prop fns)))))
(setq plist old-plist)
(setf (alist-get mode +lookup--handler-alist) plist))
(fset fn
(lambda () (lambda ()
(when (or (eq major-mode mode) (when (or (eq major-mode mode)
(and (boundp mode) (and (boundp mode)
(symbol-value mode))) (symbol-value mode)))
(cl-destructuring-bind (cl-mapc #'+lookup--set-handler
(&key definition references documentation file xref-backend async) (list definition
plist references
(when definition documentation
(add-hook '+lookup-definition-functions definition nil t)) file
(when references xref-backend)
(add-hook '+lookup-references-functions references nil t)) (list '+lookup-definition-functions
(when documentation '+lookup-references-functions
(add-hook '+lookup-documentation-functions documentation nil t)) '+lookup-documentation-functions
(when file '+lookup-file-functions
(add-hook '+lookup-file-functions file nil t)) 'xref-backend-functions)))))
(when xref-backend
(add-hook 'xref-backend-functions xref-backend nil t))))))
(add-hook hook fn)))))) (add-hook hook fn))))))
;; ;;
;; Helpers ;;; Helpers
;; Helpers (defun +lookup--set-handler (spec functions-var &optional async)
(defun +lookup--online-provider (&optional force-p namespace) (when spec
(let ((key (or namespace major-mode))) (cl-destructuring-bind (fn . plist)
(or (and (not force-p) (doom-enlist spec)
(cdr (assq key +lookup--last-provider))) (put fn '+lookup-plist (plist-put plist :async async))
(when-let* ((provider (add-hook functions-var fn nil t))))
(completing-read
"Search on: "
(mapcar #'car +lookup-provider-url-alist)
nil t)))
(setf (alist-get key +lookup--last-provider) provider)
provider))))
(defun +lookup--symbol-or-region (&optional initial) (defun +lookup--symbol-or-region (&optional initial)
(cond ((stringp initial) (cond ((stringp initial)
@ -108,60 +83,60 @@ Otherwise, these properties are available to be set:
((require 'xref nil t) ((require 'xref nil t)
(xref-backend-identifier-at-point (xref-find-backend))))) (xref-backend-identifier-at-point (xref-find-backend)))))
(defun +lookup--run-hooks (hook identifier origin &optional other-window) (defun +lookup--run-handler (handler identifier)
(doom-log "Looking up '%s' with '%s'" identifier hook) (if (commandp handler)
(condition-case-unless-debug e (call-interactively handler)
(if (get hook '+lookup-async) (funcall handler identifier)))
(progn
(when other-window (defun +lookup--run-handlers (handler identifier origin &optional other-window)
;; If async, we can't catch the window change or destination buffer (doom-log "Looking up '%s' with '%s'" identifier handler)
;; reliably, so we set up the new window ahead of time. (condition-case e
(switch-to-buffer-other-window (current-buffer)) (let ((plist (get handler '+lookup-plist)))
(goto-char (marker-position origin))) (cond ((plist-get plist :direct)
(if (commandp hook) (+lookup--run-handler handler identifier)
(call-interactively hook) t)
(funcall hook identifier)) ((plist-get plist :async)
t) (when other-window
(save-window-excursion ;; If async, we can't catch the window change or destination
(when (or (if (commandp hook) ;; buffer reliably, so we set up the new window ahead of time.
(call-interactively hook) (switch-to-buffer-other-window (current-buffer))
(funcall hook identifier)) (goto-char (marker-position origin)))
(null origin) (+lookup--run-handler handler identifier)
(/= (point-marker) origin)) t)
(point-marker)))) ((save-window-excursion
((error user-error) (and (or (+lookup--run-handler handler identifier)
(message "%s" e) (null origin)
(/= (point-marker) origin))
(point-marker))))))
((error user-error debug)
(message "Lookup handler %S: %s" handler e)
nil))) nil)))
(defun +lookup--jump-to (prop identifier &optional other-window) (defun +lookup--jump-to (prop identifier &optional other-window)
(let ((ret (let ((result
(condition-case _ (run-hook-wrapped
(run-hook-wrapped (plist-get (list :definition '+lookup-definition-functions
(plist-get (list :definition '+lookup-definition-functions :references '+lookup-references-functions
:references '+lookup-references-functions :documentation '+lookup-documentation-functions
:documentation '+lookup-documentation-functions :file '+lookup-file-functions)
:file '+lookup-file-functions) prop)
prop) #'+lookup--run-handlers
'+lookup--run-hooks identifier
identifier (point-marker)
(point-marker) other-window)))
other-window) (if (not (markerp result))
(quit (user-error "Aborted %s lookup" prop))))) (ignore (message "No lookup handler could find %S" identifier))
(cond ((null ret) (funcall (if other-window
(message "Could not find '%s'" identifier) #'switch-to-buffer-other-window
nil) #'switch-to-buffer)
((markerp ret) (marker-buffer result))
(funcall (if other-window (goto-char result)
#'switch-to-buffer-other-window (better-jumper-set-jump)
#'switch-to-buffer) result)))
(marker-buffer ret))
(goto-char ret)
(recenter)
t))))
;; ;;
;; Lookup backends ;;; Lookup backends
(defun +lookup-xref-definitions-backend (identifier) (defun +lookup-xref-definitions-backend (identifier)
"Non-interactive wrapper for `xref-find-definitions'" "Non-interactive wrapper for `xref-find-definitions'"
@ -223,18 +198,9 @@ accessed via `+lookup/in-docsets'."
(+lookup/in-docsets identifier docsets) (+lookup/in-docsets identifier docsets)
t)))) t))))
(defun +lookup-online-backend (identifier)
"Opens the browser and searches for IDENTIFIER online.
Will prompt for which search engine to use the first time (or if the universal
argument is non-nil)."
(+lookup/online
identifier
(+lookup--online-provider (not current-prefix-arg))))
;; ;;
;; Main commands ;;; Main commands
;;;###autoload ;;;###autoload
(defun +lookup/definition (identifier &optional other-window) (defun +lookup/definition (identifier &optional other-window)
@ -332,7 +298,7 @@ Otherwise, falls back on `find-file-at-point'."
;; ;;
;; Source-specific commands ;;; Source-specific commands
(defvar counsel-dash-docsets) (defvar counsel-dash-docsets)
(defvar helm-dash-docsets) (defvar helm-dash-docsets)
@ -356,47 +322,6 @@ DOCSETS is a list of docset strings. Docsets can be installed with
(counsel-dash query)) (counsel-dash query))
((user-error "No dash backend is installed, enable ivy or helm."))))) ((user-error "No dash backend is installed, enable ivy or helm.")))))
;;;###autoload
(defun +lookup/online (search &optional provider)
"Looks up SEARCH (a string) in you browser using PROVIDER.
PROVIDER should be a key of `+lookup-provider-url-alist'.
When used interactively, it will prompt for a query and, for the first time, the
provider from `+lookup-provider-url-alist'. On consecutive uses, the last
provider will be reused. If the universal argument is supplied, always prompt
for the provider."
(interactive
(list (or (and (use-region-p)
(buffer-substring-no-properties (region-beginning)
(region-end)))
(read-string "Search for: " (thing-at-point 'symbol t)))
(+lookup--online-provider current-prefix-arg)))
(condition-case-unless-debug e
(let ((url (cdr (assoc provider +lookup-provider-url-alist))))
(unless url
(user-error "'%s' is an invalid search engine" provider))
(when (or (functionp url) (symbolp url))
(setq url (funcall url)))
(cl-assert (and (stringp url) (not (string-empty-p url))))
(when (string-empty-p search)
(user-error "The search query is empty"))
(funcall +lookup-open-url-fn (format url (url-encode-url search))))
(error
(setq +lookup--last-provider
(delq (assq major-mode +lookup--last-provider)
+lookup--last-provider))
(signal (car e) (cdr e)))))
;;;###autoload
(defun +lookup/online-select ()
"Runs `+lookup/online', but always prompts for the provider to use."
(interactive)
(let ((current-prefix-arg t))
(call-interactively #'+lookup/online)))
;;
(after! evil (after! evil
(evil-set-command-property '+lookup/definition :jump t) (evil-set-command-property '+lookup/definition :jump t)
(evil-set-command-property '+lookup/references :jump t) (evil-set-command-property '+lookup/references :jump t)

65
modules/feature/lookup/autoload/online.el Normal file
View file

@ -0,0 +1,65 @@
;;; feature/lookup/autoload/online.el -*- lexical-binding: t; -*-
(defvar +lookup--last-provider nil)
(defun +lookup--online-provider (&optional force-p namespace)
(let ((key (or namespace major-mode)))
(or (and (not force-p)
(cdr (assq key +lookup--last-provider)))
(when-let* ((provider
(completing-read
"Search on: "
(mapcar #'car +lookup-provider-url-alist)
nil t)))
(setf (alist-get key +lookup--last-provider) provider)
provider))))
(defun +lookup-online-backend (identifier)
"Opens the browser and searches for IDENTIFIER online.
Will prompt for which search engine to use the first time (or if the universal
argument is non-nil)."
(+lookup/online
identifier
(+lookup--online-provider (not current-prefix-arg))))
;;;###autoload
(defun +lookup/online (search &optional provider)
"Looks up SEARCH (a string) in you browser using PROVIDER.
PROVIDER should be a key of `+lookup-provider-url-alist'.
When used interactively, it will prompt for a query and, for the first time, the
provider from `+lookup-provider-url-alist'. On consecutive uses, the last
provider will be reused. If the universal argument is supplied, always prompt
for the provider."
(interactive
(let ((provider (+lookup--online-provider current-prefix-arg)))
(list (or (and (use-region-p)
(buffer-substring-no-properties (region-beginning)
(region-end)))
(read-string (format "Search for (on %s): " provider)
(thing-at-point 'symbol t)))
provider)))
(condition-case-unless-debug e
(let ((url (cdr (assoc provider +lookup-provider-url-alist))))
(unless url
(user-error "'%s' is an invalid search engine" provider))
(when (or (functionp url) (symbolp url))
(setq url (funcall url)))
(cl-assert (stringp url))
(when (string-empty-p search)
(user-error "The search query is empty"))
(funcall +lookup-open-url-fn (format url (url-encode-url search))))
(error
(setq +lookup--last-provider
(delq (assq major-mode +lookup--last-provider)
+lookup--last-provider))
(signal (car e) (cdr e)))))
;;;###autoload
(defun +lookup/online-select ()
"Runs `+lookup/online', but always prompts for the provider to use."
(interactive)
(let ((current-prefix-arg t))
(call-interactively #'+lookup/online)))

7
modules/feature/lookup/config.el
View file

@ -4,6 +4,7 @@
;; ;;
;; + `+lookup/definition': a jump-to-definition that should 'just work' ;; + `+lookup/definition': a jump-to-definition that should 'just work'
;; + `+lookup/references': find a symbol's references in the current project ;; + `+lookup/references': find a symbol's references in the current project
;; + `+lookup/file': open the file referenced at point
;; + `+lookup/online'; look up a symbol on online resources ;; + `+lookup/online'; look up a symbol on online resources
;; + `+lookup/in-docsets': look up in Dash docsets ;; + `+lookup/in-docsets': look up in Dash docsets
;; ;;
@ -81,7 +82,7 @@ argument: the identifier at point.")
;; ;;
;; dumb-jump ;;; dumb-jump
(def-package! dumb-jump (def-package! dumb-jump
:commands dumb-jump-result-follow :commands dumb-jump-result-follow
@ -95,7 +96,7 @@ argument: the identifier at point.")
;; ;;
;; xref ;;; xref
;; By default, `etags--xref-backend' is the default xref backend. No need. We'll ;; By default, `etags--xref-backend' is the default xref backend. No need. We'll
;; set these up ourselves in other modules. ;; set these up ourselves in other modules.
@ -121,7 +122,7 @@ argument: the identifier at point.")
;; ;;
;; Dash docset integration ;;; Dash docset integration
;; Both packages depend on helm-dash, for now ;; Both packages depend on helm-dash, for now
(def-package! helm-dash (def-package! helm-dash