diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e15865d --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/.cask/ +*.elc diff --git a/Cask b/Cask new file mode 100644 index 0000000..ba8cc6e --- /dev/null +++ b/Cask @@ -0,0 +1,4 @@ +(source gnu) +(source melpa) + +(package-file "counsel-gtags.el") diff --git a/README.md b/README.md new file mode 100644 index 0000000..edf7fae --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# counsel-gtags.el + +This package is still developing. diff --git a/counsel-gtags.el b/counsel-gtags.el new file mode 100644 index 0000000..e3fa0e4 --- /dev/null +++ b/counsel-gtags.el @@ -0,0 +1,217 @@ +;;; counsel-gtags.el --- counsel for GNU global -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 by Syohei YOSHIDA + +;; Author: Syohei YOSHIDA +;; URL: https://github.com/syohex/emacs-counsel-gtags +;; Version: 0.01 +;; Package-Requires: ((emacs "24") (counsel "0.8.0")) + +;; 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. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Counsel for GNU global + +;;; Code: + +(require 'counsel) + +(declare-function cygwin-convert-file-name-from-windows "cygw32.c") +(declare-function cygwin-convert-file-name-to-windows "cygw32.c") + +(defgroup counsel-gtags nil + "counsel for GNU Global" + :group 'counsel) + +(defcustom counsel-gtags-ignore-case nil + "" + :type 'boolean) + +(defcustom counsel-gtags-path-style 'root + "" + :type '(choice (const :tag "Root of the current project" root) + (const :tag "Relative from the current directory" relative) + (const :tag "Absolute Path" absolute))) + +(defconst counsel-gtags--prompts + '((definition . "Find Definition: ") + (reference . "Find Reference: ") + (pattern . "Find Pattern: ") + (symbol . "Find Symbol: ") + (find-file . "Find File: "))) + +(defconst counsel-gtags--complete-options + '((reference . "-r") + (symbol . "-s") + (pattern . "-g") + (find-file . "-Poa"))) + +(defvar counsel-gtags--context nil) + +(defun counsel-gtags--select-gtags-label () + (let ((labels '("default" "native" "ctags" "pygments"))) + (ivy-read "GTAGSLABEL(Default: default): " labels))) + +(defun counsel-gtags--generate-tags () + (if (not (yes-or-no-p "File GTAGS not found. Run 'gtags'? ")) + (error "Abort generating tag files.") + (let* ((root (read-directory-name "Root Directory: ")) + (label (counsel-gtags--select-gtags-label)) + (default-directory root)) + (message "gtags is generating tags....") + (unless (zerop (process-file "gtags" nil nil nil "-q" + (concat "--gtagslabel=" label))) + (error "Faild: 'gtags -q'")) + root))) + +(defun counsel-gtags--root () + (or (getenv "GTAGSROOT") + (locate-dominating-file default-directory "GTAGS") + (counsel-gtags--generate-tags))) + +(defsubst counsel-gtags--windows-p () + (memq system-type '(windows-nt ms-dos))) + +(defun counsel-gtags--set-absolete-option-p () + (or (eq counsel-gtags-path-style 'absolete) + (and (counsel-gtags--windows-p) + (getenv "GTAGSLIBPATH")))) + +(defun counsel-gtags--command-options (type) + (let ((find-file-p (eq type 'find-file)) + options) + (unless find-file-p + (push "--result=grep" options)) + (let ((opt (assoc-default type counsel-gtags--complete-options))) + (when opt + (push opt options))) + (when (counsel-gtags--set-absolete-option-p) + (push "-a" options)) + (when counsel-gtags-ignore-case + (push "-i" options)) + (when (and current-prefix-arg (not find-file-p)) + (push "-l" options)) + (when (getenv "GTAGSLIBPATH") + (push "-T" options)) + options)) + +(defun counsel-gtags--complete-candidates (string type) + (let ((cmd-options (counsel-gtags--command-options type))) + (push "-c" cmd-options) + (push string cmd-options) + (counsel--async-command + (mapconcat #'shell-quote-argument (cons "global" (reverse cmd-options)) " ")) + nil)) + +(defun counsel-gtags--file-and-line (candidate) + (if (and (counsel-gtags--windows-p) + (string-match-p "\\`[a-zA-Z]:" candidate)) ;; Windows Driver letter + (when (string-match "\\`\\([^:]+:[^:]+:\\):\\([^:]+\\)" candidate) + (list (match-string-no-properties 1) + (string-to-number (match-string-no-properties 2)))) + (let ((fields (split-string candidate ":"))) + (list (cl-first fields) (string-to-number (cl-second fields)))))) + +(defun counsel-gtags--find-file (candidate) + (with-ivy-window + (swiper--cleanup) + (cl-destructuring-bind (file line) (counsel-gtags--file-and-line candidate) + (push (list :file file :line line) counsel-gtags--context) + (find-file file) + (goto-char (point-min)) + (forward-line (1- line)) + (back-to-indentation)))) + +(defun counsel-gtags--read-tag (type) + (let ((tagname (thing-at-point 'symbol)) + (prompt (assoc-default type counsel-gtags--prompts)) + (comp-fn (lambda (string) + (counsel-gtags--complete-candidates string type)))) + (ivy-read prompt comp-fn + :initial-input tagname + :dynamic-collection t + :unwind (lambda () + (counsel-delete-process) + (swiper--cleanup)) + :caller 'counsel-gtags--read-tag))) + +(defun counsel-gtags--tag-directory () + (with-temp-buffer + (or (getenv "GTAGSROOT") + (progn + (unless (zerop (process-file "global" nil t nil "-p")) + (error "GTAGS not found")) + (goto-char (point-min)) + (let ((dir (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (file-name-as-directory (if (eq system-type 'cygwin) + (cygwin-convert-file-name-from-windows dir) + dir))))))) + +(defsubst counsel-gtags--construct-command (options &optional input) + (mapconcat #'shell-quote-argument (append '("global") options (list input)) " ")) + +(defun counsel-gtags--execute (type tagname encoding) + (let* ((options (counsel-gtags--command-options type)) + (cmd (counsel-gtags--construct-command (reverse options) tagname)) + (default-directory default-directory) + (coding-system-for-read encoding) + (coding-system-for-write encoding)) + (counsel--async-command cmd nil) + nil)) + +(defun counsel-gtags--select-file (type tagname) + (let* ((tagroot (counsel-gtags--root)) + (encoding buffer-file-coding-system) + (comp-fn (lambda (_string) + (let ((default-directory tagroot)) ;; ??? + (counsel-gtags--execute type tagname encoding))))) + (ivy-read "Pattern: " comp-fn + :dynamic-collection t + :unwind (lambda () + (counsel-delete-process) + (swiper--cleanup)) + :action #'counsel-gtags--find-file + :caller 'counsel-gtags--read-tag))) + +;;;###autoload +(defun counsel-gtags-find-definition (tagname) + (interactive + (list (counsel-gtags--read-tag 'definition))) + (counsel-gtags--select-file 'definition tagname)) + +;;;###autoload +(defun counsel-gtags-find-reference (tagname) + (interactive + (list (counsel-gtags--read-tag 'reference))) + (counsel-gtags--select-file 'reference tagname)) + +;;;###autoload +(defun counsel-gtags-find-symbol (tagname) + (interactive + (list (counsel-gtags--read-tag 'symbol))) + (counsel-gtags--select-file 'symbol tagname)) + +;;;###autoload +(defun counsel-gtags-pop () + (interactive) + (let ((context (pop counsel-gtags--context))) + (find-file (plist-get context :file)) + (goto-char (point-min)) + (forward-line (1- (plist-get context :line))))) + +(provide 'counsel-gtags) + +;;; counsel-gtags.el ends here