From 8a5af077a64d7bcaaea272f8b6ea9949c7af0539 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Tue, 16 Apr 2019 20:22:17 -0400 Subject: [PATCH] feature/lookup: refactor lookup commands And move online-lookup commands to separate file --- modules/feature/lookup/autoload/lookup.el | 221 +++++++--------------- modules/feature/lookup/autoload/online.el | 65 +++++++ modules/feature/lookup/config.el | 7 +- 3 files changed, 142 insertions(+), 151 deletions(-) create mode 100644 modules/feature/lookup/autoload/online.el diff --git a/modules/feature/lookup/autoload/lookup.el b/modules/feature/lookup/autoload/lookup.el index 888a04a65..67d686fc7 100644 --- a/modules/feature/lookup/autoload/lookup.el +++ b/modules/feature/lookup/autoload/lookup.el @@ -1,11 +1,10 @@ ;;; feature/lookup/autoload/lookup.el -*- lexical-binding: t; -*- -(defvar +lookup--last-provider nil) - (defvar +lookup--handler-alist nil) ;;;###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. 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. 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 - the async response and return 'fallback. - -\(fn MODE-OR-MODES &key ASYNC DEFINITION REFERENCES DOCUMENTATION FILE XREF-BACKEND)" + the async response and return 'fallback." (declare (indent defun)) (dolist (mode (doom-enlist modes)) (let ((hook (intern (format "%s-hook" mode))) (fn (intern (format "+lookup|init-%s" mode)))) (cond ((null (car plist)) (remove-hook hook fn) - (setq +lookup--handler-alist - (delq (assq mode +lookup--handler-alist) - +lookup--handler-alist)) + (delq! mode +lookup--handler-alist 'assq) (unintern fn nil)) - ((let ((old-plist (cdr (assq mode +lookup--handler-alist))) - 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 + ((fset fn (lambda () (when (or (eq major-mode mode) (and (boundp mode) (symbol-value mode))) - (cl-destructuring-bind - (&key definition references documentation file xref-backend async) - plist - (when definition - (add-hook '+lookup-definition-functions definition nil t)) - (when references - (add-hook '+lookup-references-functions references nil t)) - (when documentation - (add-hook '+lookup-documentation-functions documentation nil t)) - (when file - (add-hook '+lookup-file-functions file nil t)) - (when xref-backend - (add-hook 'xref-backend-functions xref-backend nil t)))))) + (cl-mapc #'+lookup--set-handler + (list definition + references + documentation + file + xref-backend) + (list '+lookup-definition-functions + '+lookup-references-functions + '+lookup-documentation-functions + '+lookup-file-functions + 'xref-backend-functions))))) (add-hook hook fn)))))) ;; -;; Helpers +;;; Helpers -;; Helpers -(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--set-handler (spec functions-var &optional async) + (when spec + (cl-destructuring-bind (fn . plist) + (doom-enlist spec) + (put fn '+lookup-plist (plist-put plist :async async)) + (add-hook functions-var fn nil t)))) (defun +lookup--symbol-or-region (&optional initial) (cond ((stringp initial) @@ -108,60 +83,60 @@ Otherwise, these properties are available to be set: ((require 'xref nil t) (xref-backend-identifier-at-point (xref-find-backend))))) -(defun +lookup--run-hooks (hook identifier origin &optional other-window) - (doom-log "Looking up '%s' with '%s'" identifier hook) - (condition-case-unless-debug e - (if (get hook '+lookup-async) - (progn - (when other-window - ;; If async, we can't catch the window change or destination buffer - ;; reliably, so we set up the new window ahead of time. - (switch-to-buffer-other-window (current-buffer)) - (goto-char (marker-position origin))) - (if (commandp hook) - (call-interactively hook) - (funcall hook identifier)) - t) - (save-window-excursion - (when (or (if (commandp hook) - (call-interactively hook) - (funcall hook identifier)) - (null origin) - (/= (point-marker) origin)) - (point-marker)))) - ((error user-error) - (message "%s" e) +(defun +lookup--run-handler (handler identifier) + (if (commandp handler) + (call-interactively handler) + (funcall handler identifier))) + +(defun +lookup--run-handlers (handler identifier origin &optional other-window) + (doom-log "Looking up '%s' with '%s'" identifier handler) + (condition-case e + (let ((plist (get handler '+lookup-plist))) + (cond ((plist-get plist :direct) + (+lookup--run-handler handler identifier) + t) + ((plist-get plist :async) + (when other-window + ;; If async, we can't catch the window change or destination + ;; buffer reliably, so we set up the new window ahead of time. + (switch-to-buffer-other-window (current-buffer)) + (goto-char (marker-position origin))) + (+lookup--run-handler handler identifier) + t) + ((save-window-excursion + (and (or (+lookup--run-handler handler identifier) + (null origin) + (/= (point-marker) origin)) + (point-marker)))))) + ((error user-error debug) + (message "Lookup handler %S: %s" handler e) nil))) (defun +lookup--jump-to (prop identifier &optional other-window) - (let ((ret - (condition-case _ - (run-hook-wrapped - (plist-get (list :definition '+lookup-definition-functions - :references '+lookup-references-functions - :documentation '+lookup-documentation-functions - :file '+lookup-file-functions) - prop) - '+lookup--run-hooks - identifier - (point-marker) - other-window) - (quit (user-error "Aborted %s lookup" prop))))) - (cond ((null ret) - (message "Could not find '%s'" identifier) - nil) - ((markerp ret) - (funcall (if other-window - #'switch-to-buffer-other-window - #'switch-to-buffer) - (marker-buffer ret)) - (goto-char ret) - (recenter) - t)))) + (let ((result + (run-hook-wrapped + (plist-get (list :definition '+lookup-definition-functions + :references '+lookup-references-functions + :documentation '+lookup-documentation-functions + :file '+lookup-file-functions) + prop) + #'+lookup--run-handlers + identifier + (point-marker) + other-window))) + (if (not (markerp result)) + (ignore (message "No lookup handler could find %S" identifier)) + (funcall (if other-window + #'switch-to-buffer-other-window + #'switch-to-buffer) + (marker-buffer result)) + (goto-char result) + (better-jumper-set-jump) + result))) ;; -;; Lookup backends +;;; Lookup backends (defun +lookup-xref-definitions-backend (identifier) "Non-interactive wrapper for `xref-find-definitions'" @@ -223,18 +198,9 @@ accessed via `+lookup/in-docsets'." (+lookup/in-docsets identifier docsets) 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 (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 helm-dash-docsets) @@ -356,47 +322,6 @@ DOCSETS is a list of docset strings. Docsets can be installed with (counsel-dash query)) ((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 (evil-set-command-property '+lookup/definition :jump t) (evil-set-command-property '+lookup/references :jump t) diff --git a/modules/feature/lookup/autoload/online.el b/modules/feature/lookup/autoload/online.el new file mode 100644 index 000000000..8d088480f --- /dev/null +++ b/modules/feature/lookup/autoload/online.el @@ -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))) diff --git a/modules/feature/lookup/config.el b/modules/feature/lookup/config.el index da3769116..701d98959 100644 --- a/modules/feature/lookup/config.el +++ b/modules/feature/lookup/config.el @@ -4,6 +4,7 @@ ;; ;; + `+lookup/definition': a jump-to-definition that should 'just work' ;; + `+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/in-docsets': look up in Dash docsets ;; @@ -81,7 +82,7 @@ argument: the identifier at point.") ;; -;; dumb-jump +;;; dumb-jump (def-package! dumb-jump :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 ;; 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 (def-package! helm-dash