emacs/code/elpa/helm-xref-20211017.1334/helm-xref.el

201 lines
6.6 KiB
EmacsLisp

;;; helm-xref.el --- Helm interface for xref results -*- lexical-binding: t -*-
;; Copyright (C) 2017 Fritz Stelzer <brotzeitmacher@gmail.com>
;; Author: Fritz Stelzer <brotzeitmacher@gmail.com>
;; URL: https://github.com/brotzeit/helm-xref
;; Version: 1.0
;; Package-Requires: ((emacs "25.1") (helm "1.9.4"))
;;; License:
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;; Contributors:
;; Sanjeev Sivasankaran <kalasalatemp at gmail.com> in 2019 changed font-face.
;;; Code:
(require 'helm)
(require 'helm-utils)
(require 'xref)
(require 'cl-seq)
(defvar helm-xref-alist nil
"Holds helm candidates.")
(defgroup helm-xref nil
"Xref with helm."
:prefix "helm-xref-" :group 'helm)
(defface helm-xref-file-name
'((t (:inherit 'font-lock-builtin-face)))
"Face for xref file name"
:group 'helm-xref)
(defface helm-xref-line-number
'((t (:inherit 'helm-grep-lineno)))
"Face for xref line number"
:group 'helm-xref)
(defcustom helm-xref-candidate-formatting-function 'helm-xref-format-candidate-short
"Select the function for candidate formatting."
:type '(radio
(function-item helm-xref-format-candidate-short)
(function-item helm-xref-format-candidate-full-path)
(function-item helm-xref-format-candidate-long)
function)
:group 'helm-xref)
(defcustom helm-xref-input ""
"Initial input in Helm."
:type 'string
:group 'helm-xref)
(defun helm-xref-candidates-26 (xrefs)
"Convert XREF-ALIST items to helm candidates and add them to `helm-xref-alist'."
(dolist (xref xrefs)
(let* ((summary (xref-item-summary xref))
(location (xref-item-location xref))
(line (xref-location-line location))
(file (xref-location-group location))
candidate)
(setq candidate
(funcall helm-xref-candidate-formatting-function file line summary))
(push (cons candidate xref) helm-xref-alist)))
(setq helm-xref-alist (reverse helm-xref-alist)))
(defun helm-xref-candidates-27 (fetcher alist)
"Convert XREF-ALIST items to helm candidates and add them to `helm-xref-alist'."
(cl-assert (functionp fetcher))
(let* ((xrefs
(or
(assoc-default 'fetched-xrefs alist)
(funcall fetcher))))
(dolist (xref xrefs)
(let* ((summary (xref-item-summary xref))
(location (xref-item-location xref))
(line (xref-location-line location))
(file (xref-location-group location))
candidate)
(setq candidate
(funcall helm-xref-candidate-formatting-function file line summary))
(push (cons candidate xref) helm-xref-alist))))
(setq helm-xref-alist (reverse helm-xref-alist)))
(defun helm-xref-format-candidate-short (file line summary)
"Build short form of candidate format with FILE, LINE, and SUMMARY."
(concat
(propertize (car (reverse (split-string file "\\/")))
'font-lock-face 'helm-xref-file-name)
(when (string= "integer" (type-of line))
(concat
":"
(propertize (int-to-string line)
'font-lock-face 'helm-xref-line-number)))
":"
summary))
(defun helm-xref-format-candidate-full-path (file line summary)
"Same as `helm-xref-format-candidate-short', but display entire path."
(concat
(propertize file 'font-lock-face 'helm-xref-file-name)
(when (string= "integer" (type-of line))
(concat
":"
(propertize (int-to-string line)
'font-lock-face 'helm-xref-line-number)))
":"
summary))
(defun helm-xref-format-candidate-long (file line summary)
"Use two lines for each candidate. One contains the path and the other the actual candidate."
(concat
(propertize file 'font-lock-face 'helm-xref-file-name)
(when (string= "integer" (type-of line))
(concat
"\n:"
(propertize (int-to-string line)
'font-lock-face 'helm-xref-line-number)))
":"
summary))
(defun helm-xref-goto-xref-item (item func)
"Set buffer and point according to xref-item ITEM.
Use FUNC to display buffer."
(let* ((summary (xref-item-summary item))
(location (xref-item-location item))
(marker (xref-location-marker location))
(buf (marker-buffer marker))
(offset (marker-position marker)))
(switch-to-buffer buf)
(goto-char offset)
(funcall func buf)))
(defun helm-xref-source ()
"Return a `helm' source for xref results."
(helm-build-sync-source "Helm Xref"
:candidates helm-xref-alist
:persistent-action (lambda (item)
(helm-xref-goto-xref-item
item '(lambda (buf) (helm-highlight-current-line))))
:action '(("Switch to buffer" . (lambda (item) (helm-xref-goto-xref-item item 'switch-to-buffer)))
("Other window" . (lambda (item) (helm-xref-goto-xref-item item 'switch-to-buffer-other-window))))
:candidate-number-limit 9999))
;;;###autoload
(defun helm-xref-show-xrefs (xrefs _alist)
"Function to display XREFS.
Needs to be set the value of `xref-show-xrefs-function'."
(setq helm-xref-alist nil)
(helm-xref-candidates-26 xrefs)
(helm :sources (helm-xref-source)
:truncate-lines t
:input helm-xref-input
:buffer "*helm-xref*"))
;;;###autoload
(defun helm-xref-show-xrefs-27 (fetcher alist)
"Function to display XREFS.
Needs to be set the value of `xref-show-xrefs-function'."
(setq helm-xref-alist nil)
(helm-xref-candidates-27 fetcher alist)
(helm :sources (helm-xref-source)
:truncate-lines t
:buffer "*helm-xref*"))
;;;###autoload
(defun helm-xref-show-defs-27 (fetcher alist)
"Function to display list of definitions."
(let ((xrefs (funcall fetcher)))
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
(helm-xref-show-xrefs-27 fetcher
(cons (cons 'fetched-xrefs xrefs)
alist))))))
;;;###autoload
(progn
(if (< emacs-major-version 27)
(setq xref-show-xrefs-function 'helm-xref-show-xrefs)
(progn
(setq xref-show-xrefs-function 'helm-xref-show-xrefs-27)
(setq xref-show-definitions-function 'helm-xref-show-defs-27))))
(provide 'helm-xref)
;;; helm-xref.el ends here