;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2012 ~ 2014 Daniel Hackney <dan@haxney.org>
|
|
;; Author: Daniel Hackney <dan@haxney.org>
|
|
|
|
;; 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 <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Uses `candidates-in-buffer' for speed.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'semantic)
|
|
(require 'helm-imenu)
|
|
|
|
(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face))
|
|
|
|
(defcustom helm-semantic-lynx-style-map t
|
|
"Use Arrow keys to jump to occurences."
|
|
:group 'helm-imenu
|
|
:type 'boolean)
|
|
|
|
;;; keymap
|
|
(defvar helm-semantic-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map helm-map)
|
|
(define-key map (kbd "C-c ?") 'helm-semantic-help)
|
|
(when helm-imenu-lynx-style-map
|
|
(define-key map (kbd "<left>") 'helm-maybe-exit-minibuffer)
|
|
(define-key map (kbd "<right>") 'helm-execute-persistent-action))
|
|
(delq nil map)))
|
|
|
|
(defun helm-semantic-init-candidates (tags depth &optional class)
|
|
"Write the contents of TAGS to the current buffer."
|
|
(let ((class class) cur-type)
|
|
(cl-dolist (tag tags)
|
|
(when (listp tag)
|
|
(cl-case (setq cur-type (semantic-tag-class tag))
|
|
((function variable type)
|
|
(let ((spaces (make-string (* depth 2) ?\s))
|
|
(type-p (eq cur-type 'type)))
|
|
(unless (and (> depth 0) (not type-p))
|
|
(setq class nil))
|
|
(insert
|
|
(if (and class (not type-p))
|
|
(format "%s%sClass(%s) "
|
|
spaces (if (< depth 2) "" "├►") class)
|
|
spaces)
|
|
;; Save the tag for later
|
|
(propertize (semantic-format-tag-summarize tag nil t)
|
|
'semantic-tag tag)
|
|
"\n")
|
|
(and type-p (setq class (car tag)))
|
|
;; Recurse to children
|
|
(helm-semantic-init-candidates
|
|
(semantic-tag-components tag) (1+ depth) class)))
|
|
|
|
;; Don't do anything with packages or includes for now
|
|
((package include)
|
|
(insert
|
|
(propertize (semantic-format-tag-summarize tag nil t)
|
|
'semantic-tag tag)
|
|
"\n")
|
|
)
|
|
;; Catch-all
|
|
(t))))))
|
|
|
|
(defun helm-semantic-default-action (_candidate &optional persistent)
|
|
;; By default, helm doesn't pass on the text properties of the selection.
|
|
;; Fix this.
|
|
(helm-log-run-hook 'helm-goto-line-before-hook)
|
|
(with-current-buffer helm-buffer
|
|
(when (looking-at " ")
|
|
(goto-char (next-single-property-change
|
|
(point-at-bol) 'semantic-tag nil (point-at-eol))))
|
|
(let ((tag (get-text-property (point) 'semantic-tag)))
|
|
(semantic-go-to-tag tag)
|
|
(unless persistent
|
|
(pulse-momentary-highlight-one-line (point))))))
|
|
|
|
(defun helm-semantic--maybe-set-needs-update ()
|
|
(with-helm-current-buffer
|
|
(let ((tick (buffer-modified-tick)))
|
|
(unless (eq helm-cached-imenu-tick tick)
|
|
(setq helm-cached-imenu-tick tick)
|
|
(semantic-parse-tree-set-needs-update)))))
|
|
|
|
(defvar helm-source-semantic
|
|
`((name . "Semantic Tags")
|
|
(init . (lambda ()
|
|
(helm-semantic--maybe-set-needs-update)
|
|
(let ((tags (semantic-fetch-tags)))
|
|
(with-current-buffer (helm-candidate-buffer 'global)
|
|
(helm-semantic-init-candidates tags 0)))))
|
|
(candidates-in-buffer)
|
|
(allow-dups)
|
|
(get-line . buffer-substring)
|
|
(persistent-action . (lambda (elm)
|
|
(helm-semantic-default-action elm t)
|
|
(helm-highlight-current-line)))
|
|
(persistent-help . "Show this entry")
|
|
(keymap . ,helm-semantic-map)
|
|
(mode-line . helm-semantic-mode-line)
|
|
(action . helm-semantic-default-action)
|
|
"Source to search tags using Semantic from CEDET."))
|
|
|
|
;;;###autoload
|
|
(defun helm-semantic ()
|
|
"Preconfigured `helm' for `semantic'."
|
|
(interactive)
|
|
(let ((str (thing-at-point 'symbol)))
|
|
(helm :sources 'helm-source-semantic
|
|
:default (list (concat "\\_<" str "\\_>") str)
|
|
:candidate-number-limit 9999
|
|
:buffer "*helm semantic*")))
|
|
|
|
;;;###autoload
|
|
(defun helm-semantic-or-imenu ()
|
|
"Run `helm' with `semantic' or `imenu'.
|
|
|
|
If `semantic-mode' is active in the current buffer, then use
|
|
semantic for generating tags, otherwise fall back to `imenu'.
|
|
Fill in the symbol at point by default."
|
|
(interactive)
|
|
(let* ((source (if (semantic-active-p)
|
|
'helm-source-semantic
|
|
'helm-source-imenu))
|
|
(imenu-p (eq source 'helm-source-imenu))
|
|
(str (thing-at-point 'symbol))
|
|
(imenu-auto-rescan imenu-p)
|
|
(helm-execute-action-at-once-if-one
|
|
(and imenu-p
|
|
helm-imenu-execute-action-at-once-if-one)))
|
|
(helm :sources source
|
|
:default (list (concat "\\_<" str "\\_>") str)
|
|
:buffer "*helm semantic/imenu*"
|
|
:candidate-number-limit 9999
|
|
:preselect (unless imenu-p (thing-at-point 'symbol)))))
|
|
|
|
(provide 'helm-semantic)
|
|
|
|
;; Local Variables:
|
|
;; byte-compile-warnings: (not cl-functions obsolete)
|
|
;; coding: utf-8
|
|
;; indent-tabs-mode: nil
|
|
;; End:
|
|
|
|
;;; helm-semantic.el ends here
|