| commit | author | age | ||
| 5cb5f7 | 1 | ;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2012 ~ 2017 Daniel Hackney <dan@haxney.org> | |
| 4 | ;; 2012 ~ 2018 Thierry Volpiatto<thierry.volpiatto@gmail.com> | |
| 5 | ||
| 6 | ;; Author: Daniel Hackney <dan@haxney.org> | |
| 7 | ||
| 8 | ;; This program is free software; you can redistribute it and/or modify | |
| 9 | ;; it under the terms of the GNU General Public License as published by | |
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 11 | ;; (at your option) any later version. | |
| 12 | ||
| 13 | ;; This program is distributed in the hope that it will be useful, | |
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 16 | ;; GNU General Public License for more details. | |
| 17 | ||
| 18 | ;; You should have received a copy of the GNU General Public License | |
| 19 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
| 20 | ||
| 21 | ;;; Commentary: | |
| 22 | ||
| 23 | ;; Uses `candidates-in-buffer' for speed. | |
| 24 | ||
| 25 | ;;; Code: | |
| 26 | ||
| 27 | (require 'cl-lib) | |
| 28 | (require 'semantic) | |
| 29 | (require 'helm-help) | |
| 30 | (require 'helm-imenu) | |
| 31 | ||
| 32 | (declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face)) | |
| 33 | ||
| 34 | (defgroup helm-semantic nil | |
| 35 | "Semantic tags related libraries and applications for helm." | |
| 36 | :group 'helm) | |
| 37 | ||
| 38 | (defcustom helm-semantic-lynx-style-map t | |
| 39 | "Use Arrow keys to jump to occurences." | |
| 40 | :group 'helm-semantic | |
| 41 | :type 'boolean) | |
| 42 | ||
| 43 | (defcustom helm-semantic-display-style | |
| 44 | '((python-mode . semantic-format-tag-summarize) | |
| 45 | (c-mode . semantic-format-tag-concise-prototype-c-mode) | |
| 46 | (emacs-lisp-mode . semantic-format-tag-abbreviate-emacs-lisp-mode)) | |
| 47 | "Function to present a semantic tag according to `major-mode'. | |
| 48 | ||
| 49 | It is an alist where the `car' of each element is a `major-mode' and | |
| 50 | the `cdr' a `semantic-format-tag-*' function. | |
| 51 | ||
| 52 | If no function is found for current `major-mode', fall back to | |
| 53 | `semantic-format-tag-summarize' default function. | |
| 54 | ||
| 55 | You can have more or less informations depending of the `semantic-format-tag-*' | |
| 56 | function you choose. | |
| 57 | ||
| 58 | All the supported functions are prefixed with \"semantic-format-tag-\", | |
| 59 | you have completion on these functions with `C-M i' in the customize interface." | |
| 60 | :group 'helm-semantic | |
| 61 | :type '(alist :key-type symbol :value-type symbol)) | |
| 62 | ||
| 63 | ;;; keymap | |
| 64 | (defvar helm-semantic-map | |
| 65 | (let ((map (make-sparse-keymap))) | |
| 66 | (set-keymap-parent map helm-map) | |
| 67 | (when helm-semantic-lynx-style-map | |
| 68 | (define-key map (kbd "<left>") 'helm-maybe-exit-minibuffer) | |
| 69 | (define-key map (kbd "<right>") 'helm-execute-persistent-action)) | |
| 70 | (delq nil map))) | |
| 71 | ||
| 72 | ;; Internals vars | |
| 73 | (defvar helm-semantic--tags-cache nil) | |
| 74 | ||
| 75 | (defun helm-semantic--fetch-candidates (tags depth &optional class) | |
| 76 | "Write the contents of TAGS to the current buffer." | |
| 77 | (let ((class class) cur-type | |
| 78 | (stylefn (or (with-helm-current-buffer | |
| 79 | (assoc-default major-mode helm-semantic-display-style)) | |
| 80 | #'semantic-format-tag-summarize))) | |
| 81 | (cl-dolist (tag tags) | |
| 82 | (when (listp tag) | |
| 83 | (cl-case (setq cur-type (semantic-tag-class tag)) | |
| 84 | ((function variable type) | |
| 85 | (let ((spaces (make-string (* depth 2) ?\s)) | |
| 86 | (type-p (eq cur-type 'type))) | |
| 87 | (unless (and (> depth 0) (not type-p)) | |
| 88 | (setq class nil)) | |
| 89 | (insert | |
| 90 | (if (and class (not type-p)) | |
| 91 | (format "%s%s(%s) " | |
| 92 | spaces (if (< depth 2) "" "├►") class) | |
| 93 | spaces) | |
| 94 | ;; Save the tag for later | |
| 95 | (propertize (funcall stylefn tag nil t) | |
| 96 | 'semantic-tag tag) | |
| 97 | "\n") | |
| 98 | (and type-p (setq class (car tag))) | |
| 99 | ;; Recurse to children | |
| 100 | (unless (eq cur-type 'function) | |
| 101 | (helm-semantic--fetch-candidates | |
| 102 | (semantic-tag-components tag) (1+ depth) class)))) | |
| 103 | ||
| 104 | ;; Don't do anything with packages or includes for now | |
| 105 | ((package include) | |
| 106 | (insert | |
| 107 | (propertize (funcall stylefn tag nil t) | |
| 108 | 'semantic-tag tag) | |
| 109 | "\n") | |
| 110 | ) | |
| 111 | ;; Catch-all | |
| 112 | (t)))))) | |
| 113 | ||
| 114 | (defun helm-semantic-default-action (_candidate &optional persistent) | |
| 115 | ;; By default, helm doesn't pass on the text properties of the selection. | |
| 116 | ;; Fix this. | |
| 117 | (helm-log-run-hook 'helm-goto-line-before-hook) | |
| 118 | (with-current-buffer helm-buffer | |
| 119 | (when (looking-at " ") | |
| 120 | (goto-char (next-single-property-change | |
| 121 | (point-at-bol) 'semantic-tag nil (point-at-eol)))) | |
| 122 | (let ((tag (get-text-property (point) 'semantic-tag))) | |
| 123 | (semantic-go-to-tag tag) | |
| 124 | (unless persistent | |
| 125 | (pulse-momentary-highlight-one-line (point)))))) | |
| 126 | ||
| 127 | (defun helm-semantic--maybe-set-needs-update () | |
| 128 | (with-helm-current-buffer | |
| 129 | (when (semantic-parse-tree-needs-update-p) | |
| 130 | (semantic-parse-tree-set-needs-update)))) | |
| 131 | ||
| 132 | (defvar helm-source-semantic nil) | |
| 133 | ||
| 134 | (defclass helm-semantic-source (helm-source-in-buffer) | |
| 135 | ((init :initform (lambda () | |
| 136 | (helm-semantic--maybe-set-needs-update) | |
| 137 | (setq helm-semantic--tags-cache (semantic-fetch-tags)) | |
| 138 | (with-current-buffer (helm-candidate-buffer 'global) | |
| 139 | (let ((major-mode (with-helm-current-buffer major-mode))) | |
| 140 | (helm-semantic--fetch-candidates helm-semantic--tags-cache 0))))) | |
| 141 | (get-line :initform 'buffer-substring) | |
| 142 | (persistent-help :initform "Show this entry") | |
| 143 | (keymap :initform 'helm-semantic-map) | |
| 144 | (help-message :initform 'helm-semantic-help-message) | |
| 145 | (persistent-action :initform (lambda (elm) | |
| 146 | (helm-semantic-default-action elm t) | |
| 147 | (helm-highlight-current-line))) | |
| 148 | (action :initform 'helm-semantic-default-action))) | |
| 149 | ||
| 150 | (defcustom helm-semantic-fuzzy-match nil | |
| 151 | "Enable fuzzy matching in `helm-source-semantic'." | |
| 152 | :group 'helm-semantic | |
| 153 | :type 'boolean | |
| 154 | :set (lambda (var val) | |
| 155 | (set var val) | |
| 156 | (setq helm-source-semantic | |
| 157 | (helm-make-source "Semantic Tags" 'helm-semantic-source | |
| 158 | :fuzzy-match helm-semantic-fuzzy-match)))) | |
| 159 | ||
| 160 | ;;;###autoload | |
| 161 | (defun helm-semantic (arg) | |
| 162 | "Preconfigured `helm' for `semantic'. | |
| 163 | If ARG is supplied, pre-select symbol at point instead of current" | |
| 164 | (interactive "P") | |
| 165 | (let ((tag (helm-aif (car (semantic-current-tag-parent)) | |
| 166 | (let ((curtag (car (semantic-current-tag)))) | |
| 167 | (if (string= it curtag) | |
| 168 | (format "\\_<%s\\_>" curtag) | |
| 169 | (cons (format "\\_<%s\\_>" it) | |
| 170 | (format "\\_<%s\\_>" curtag)))) | |
| 171 | (format "\\_<%s\\_>" (car (semantic-current-tag)))))) | |
| 172 | (unless helm-source-semantic | |
| 173 | (setq helm-source-semantic | |
| 174 | (helm-make-source "Semantic Tags" 'helm-semantic-source | |
| 175 | :fuzzy-match helm-semantic-fuzzy-match))) | |
| 176 | (helm :sources 'helm-source-semantic | |
| 177 | :candidate-number-limit 9999 | |
| 178 | :preselect (if arg | |
| 179 | (thing-at-point 'symbol) | |
| 180 | tag) | |
| 181 | :buffer "*helm semantic*"))) | |
| 182 | ||
| 183 | ;;;###autoload | |
| 184 | (defun helm-semantic-or-imenu (arg) | |
| 185 | "Preconfigured helm for `semantic' or `imenu'. | |
| 186 | If ARG is supplied, pre-select symbol at point instead of current | |
| 187 | semantic tag in scope. | |
| 188 | ||
| 189 | If `semantic-mode' is active in the current buffer, then use | |
| 190 | semantic for generating tags, otherwise fall back to `imenu'. | |
| 191 | Fill in the symbol at point by default." | |
| 192 | (interactive "P") | |
| 193 | (unless helm-source-semantic | |
| 194 | (setq helm-source-semantic | |
| 195 | (helm-make-source "Semantic Tags" 'helm-semantic-source | |
| 196 | :fuzzy-match helm-semantic-fuzzy-match))) | |
| 197 | (unless helm-source-imenu | |
| 198 | (setq helm-source-imenu | |
| 199 | (helm-make-source "Imenu" 'helm-imenu-source | |
| 200 | :fuzzy-match helm-imenu-fuzzy-match))) | |
| 201 | (let* ((source (if (semantic-active-p) | |
| 202 | 'helm-source-semantic | |
| 203 | 'helm-source-imenu)) | |
| 204 | (imenu-p (eq source 'helm-source-imenu)) | |
| 205 | (imenu-auto-rescan imenu-p) | |
| 206 | (str (thing-at-point 'symbol)) | |
| 207 | (helm-execute-action-at-once-if-one | |
| 208 | (and imenu-p | |
| 209 | helm-imenu-execute-action-at-once-if-one)) | |
| 210 | (tag (helm-aif (car (semantic-current-tag-parent)) | |
| 211 | (let ((curtag (car (semantic-current-tag)))) | |
| 212 | (if (string= it curtag) | |
| 213 | (format "\\_<%s\\_>" curtag) | |
| 214 | (cons (format "\\_<%s\\_>" it) | |
| 215 | (format "\\_<%s\\_>" curtag)))) | |
| 216 | (format "\\_<%s\\_>" (car (semantic-current-tag)))))) | |
| 217 | (helm :sources source | |
| 218 | :candidate-number-limit 9999 | |
| 219 | :default (and imenu-p (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str)) | |
| 220 | :preselect (if (or arg imenu-p) str tag) | |
| 221 | :buffer "*helm semantic/imenu*"))) | |
| 222 | ||
| 223 | (provide 'helm-semantic) | |
| 224 | ||
| 225 | ;; Local Variables: | |
| 226 | ;; byte-compile-warnings: (not obsolete) | |
| 227 | ;; coding: utf-8 | |
| 228 | ;; indent-tabs-mode: nil | |
| 229 | ;; End: | |
| 230 | ||
| 231 | ;;; helm-semantic.el ends here | |
