Klimi's new dotfiles with stow.
Ви не можете вибрати більше 25 тем Теми мають розпочинатися з літери або цифри, можуть містити дефіси (-) і не повинні перевищувати 35 символів.

236 рядки
9.1 KiB

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