lisp/cedet/semantic/symref/list.el

   1 ;;; semantic/symref/list.el --- Symref Output List UI.
   2
   3 ;; Copyright (C) 2008, 2009  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Provide a simple user facing API to finding symbol references.
  25 ;;
  26 ;; This UI is the base of some refactoring tools.  For any refactor,
  27 ;; the user will execture [FIXME what?] `semantic-symref' in a tag.
  28 ;; Once that data is collected, the output will be listed in a buffer.
  29 ;; In the output buffer, the user can then initiate different
  30 ;; refactoring operations.
  31 ;;
  32 ;; NOTE: Need to add some refactoring tools.
  33
  34 (require 'semantic/symref)
  35 (require 'semantic/complete)
  36 (require 'pulse)
  37
  38 ;;; Code:
  39
  40 ;;;###autoload
  41 (defun semantic-symref ()
  42   "Find references to the current tag.
  43 This command uses the currently configured references tool within the
  44 current project to find references to the current tag.  The
  45 references are the organized by file and the name of the function
  46 they are used in.
  47 Display the references in`semantic-symref-results-mode'."
  48   (interactive)
  49   (semantic-fetch-tags)
  50   (let ((ct (semantic-current-tag))
  51         (res nil)
  52         )
  53     ;; Must have a tag...
  54     (when (not ct) (error "Place cursor inside tag to be searched for"))
  55     ;; Check w/ user.
  56     (when (not (y-or-n-p (format "Find references for %s? " (semantic-tag-name ct))))
  57       (error "Quit"))
  58     ;; Gather results and tags
  59     (message "Gathering References...")
  60     (setq res (semantic-symref-find-references-by-name (semantic-tag-name ct)))
  61     (semantic-symref-produce-list-on-results res (semantic-tag-name ct))))
  62
  63 ;;;###autoload
  64 (defun semantic-symref-symbol (sym)
  65   "Find references to the symbol SYM.
  66 This command uses the currently configured references tool within the
  67 current project to find references to the input SYM.  The
  68 references are the organized by file and the name of the function
  69 they are used in.
  70 Display the references in`semantic-symref-results-mode'."
  71   (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep
  72                                          "Symrefs for: "))))
  73   (semantic-fetch-tags)
  74   (let ((res nil)
  75         )
  76     ;; Gather results and tags
  77     (message "Gathering References...")
  78     (setq res (semantic-symref-find-references-by-name sym))
  79     (semantic-symref-produce-list-on-results res sym)))
  80
  81
  82 (defun semantic-symref-produce-list-on-results (res str)
  83   "Produce a symref list mode buffer on the results RES."
  84     (when (not res) (error "No references found"))
  85     (semantic-symref-result-get-tags res t)
  86     (message "Gathering References...done")
  87     ;; Build a refrences buffer.
  88     (let ((buff (get-buffer-create
  89                  (format "*Symref %s" str)))
  90           )
  91       (switch-to-buffer-other-window buff)
  92       (set-buffer buff)
  93       (semantic-symref-results-mode res))
  94     )
  95
  96 ;;; RESULTS MODE
  97 ;;
  98 (defgroup semantic-symref-results-mode nil
  99   "Symref Results group."
 100   :group 'semantic)
 101
 102 (defvar semantic-symref-results-mode-map
 103   (let ((km (make-sparse-keymap)))
 104     (define-key km "\C-i" 'forward-button)
 105     (define-key km "\M-C-i" 'backward-button)
 106     (define-key km " " 'push-button)
 107     (define-key km "-" 'semantic-symref-list-toggle-showing)
 108     (define-key km "=" 'semantic-symref-list-toggle-showing)
 109     (define-key km "+" 'semantic-symref-list-toggle-showing)
 110     (define-key km "n" 'semantic-symref-list-next-line)
 111     (define-key km "p" 'semantic-symref-list-prev-line)
 112     (define-key km "q" 'semantic-symref-hide-buffer)
 113     km)
 114   "Keymap used in `semantic-symref-results-mode'.")
 115
 116 (defcustom semantic-symref-results-mode-hook nil
 117   "*Hook run when `semantic-symref-results-mode' starts."
 118   :group 'semantic-symref
 119   :type 'hook)
 120
 121 (defvar semantic-symref-current-results nil
 122   "The current results in a results mode buffer.")
 123
 124 (defun semantic-symref-results-mode (results)
 125   "Major-mode for displaying Semantic Symbol Reference RESULTS.
 126 RESULTS is an object of class `semantic-symref-results'."
 127   (interactive)
 128   (kill-all-local-variables)
 129   (setq major-mode 'semantic-symref-results-mode
 130         mode-name "Symref"
 131         )
 132   (use-local-map semantic-symref-results-mode-map)
 133   (set (make-local-variable 'semantic-symref-current-results)
 134        results)
 135   (semantic-symref-results-dump results)
 136   (goto-char (point-min))
 137   (buffer-disable-undo)
 138   (set (make-local-variable 'font-lock-global-modes) nil)
 139   (font-lock-mode -1)
 140   (run-hooks 'semantic-symref-results-mode-hook)
 141   )
 142
 143 (defun semantic-symref-hide-buffer ()
 144   "Hide buffer with semantic-symref results."
 145   (interactive)
 146   (bury-buffer))
 147
 148 (defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype
 149   "*Function to use when creating items in Imenu.
 150 Some useful functions are found in `semantic-format-tag-functions'."
 151   :group 'semantic-symref
 152   :type semantic-format-tag-custom-list)
 153
 154 (defun semantic-symref-results-dump (results)
 155   "Dump the RESULTS into the current buffer."
 156   ;; Get ready for the insert.
 157   (toggle-read-only -1)
 158   (erase-buffer)
 159
 160   ;; Insert the contents.
 161   (let ((lastfile nil)
 162         )
 163     (dolist (T (oref results :hit-tags))
 164
 165       (when (not (equal lastfile (semantic-tag-file-name T)))
 166         (setq lastfile (semantic-tag-file-name T))
 167         (insert-button lastfile
 168                        'mouse-face 'custom-button-pressed-face
 169                        'action 'semantic-symref-rb-goto-file
 170                        'tag T
 171                        )
 172         (insert "\n"))
 173
 174       (insert "  ")
 175       (insert-button "[+]"
 176                      'mouse-face 'highlight
 177                      'face nil
 178                      'action 'semantic-symref-rb-toggle-expand-tag
 179                      'tag T
 180                      'state 'closed)
 181       (insert " ")
 182       (insert-button (funcall semantic-symref-results-summary-function
 183                               T nil t)
 184                      'mouse-face 'custom-button-pressed-face
 185                      'face nil
 186                      'action 'semantic-symref-rb-goto-tag
 187                      'tag T)
 188       (insert "\n")
 189
 190       ))
 191
 192   ;; Clean up the mess
 193   (toggle-read-only 1)
 194   (set-buffer-modified-p nil)
 195   )
 196
 197 ;;; Commands for semantic-symref-results
 198 ;;
 199 (defun semantic-symref-list-toggle-showing ()
 200   "Toggle showing the contents below the current line."
 201   (interactive)
 202   (beginning-of-line)
 203   (when (re-search-forward "\\[[-+]\\]" (point-at-eol) t)
 204     (forward-char -1)
 205     (push-button)))
 206
 207 (defun semantic-symref-rb-toggle-expand-tag (&optional button)
 208   "Go to the file specified in the symref results buffer.
 209 BUTTON is the button that was clicked."
 210   (interactive)
 211   (let* ((tag (button-get button 'tag))
 212          (buff (semantic-tag-buffer tag))
 213          (hits (semantic--tag-get-property tag :hit))
 214          (state (button-get button 'state))
 215          (text nil)
 216          )
 217     (cond
 218      ((eq state 'closed)
 219       (toggle-read-only -1)
 220       (with-current-buffer buff
 221         (dolist (H hits)
 222           (goto-char (point-min))
 223           (forward-line (1- H))
 224           (beginning-of-line)
 225           (back-to-indentation)
 226           (setq text (cons (buffer-substring (point) (point-at-eol)) text)))
 227         (setq text (nreverse text))
 228         )
 229       (goto-char (button-start button))
 230       (forward-char 1)
 231       (delete-char 1)
 232       (insert "-")
 233       (button-put button 'state 'open)
 234       (save-excursion
 235         (end-of-line)
 236         (while text
 237         (insert "\n")
 238           (insert "    ")
 239           (insert-button (car text)
 240                          'mouse-face 'highlight
 241                          'face nil
 242                          'action 'semantic-symref-rb-goto-match
 243                          'tag tag
 244                          'line (car hits))
 245           (setq text (cdr text)
 246                 hits (cdr hits))))
 247       (toggle-read-only 1)
 248       )
 249      ((eq state 'open)
 250       (toggle-read-only -1)
 251       (button-put button 'state 'closed)
 252       ;; Delete the various bits.
 253       (goto-char (button-start button))
 254       (forward-char 1)
 255       (delete-char 1)
 256       (insert "+")
 257       (save-excursion
 258         (end-of-line)
 259         (forward-char 1)
 260         (delete-region (point)
 261                        (save-excursion
 262                          (forward-char 1)
 263                          (forward-line (length hits))
 264                          (point))))
 265       (toggle-read-only 1)
 266       )
 267      ))
 268   )
 269
 270 (defun semantic-symref-rb-goto-file (&optional button)
 271   "Go to the file specified in the symref results buffer.
 272 BUTTON is the button that was clicked."
 273   (let* ((tag (button-get button 'tag))
 274          (buff (semantic-tag-buffer tag))
 275          (win (selected-window))
 276          )
 277     (switch-to-buffer-other-window buff)
 278     (pulse-momentary-highlight-one-line (point))
 279     (when (eq last-command-event ?\s) (select-window win))
 280     ))
 281
 282
 283 (defun semantic-symref-rb-goto-tag (&optional button)
 284   "Go to the file specified in the symref results buffer.
 285 BUTTON is the button that was clicked."
 286   (interactive)
 287   (let* ((tag (button-get button 'tag))
 288          (buff (semantic-tag-buffer tag))
 289          (win (selected-window))
 290          )
 291     (switch-to-buffer-other-window buff)
 292     (semantic-go-to-tag tag)
 293     (pulse-momentary-highlight-one-line (point))
 294     (when (eq last-command-event ?\s) (select-window win))
 295     )
 296   )
 297
 298 (defun semantic-symref-rb-goto-match (&optional button)
 299   "Go to the file specified in the symref results buffer.
 300 BUTTON is the button that was clicked."
 301   (interactive)
 302   (let* ((tag (button-get button 'tag))
 303          (line (button-get button 'line))
 304          (buff (semantic-tag-buffer tag))
 305          (win (selected-window))
 306          )
 307     (switch-to-buffer-other-window buff)
 308     (with-no-warnings (goto-line line))
 309     (pulse-momentary-highlight-one-line (point))
 310     (when (eq last-command-event ?\s) (select-window win))
 311     )
 312   )
 313
 314 (defun semantic-symref-list-next-line ()
 315   "Next line in `semantic-symref-results-mode'."
 316   (interactive)
 317   (forward-line 1)
 318   (back-to-indentation))
 319
 320 (defun semantic-symref-list-prev-line ()
 321   "Next line in `semantic-symref-results-mode'."
 322   (interactive)
 323   (forward-line -1)
 324   (back-to-indentation))
 325
 326 (provide 'semantic/symref/list)
 327
 328 ;; Local variables:
 329 ;; generated-autoload-file: "../loaddefs.el"
 330 ;; generated-autoload-feature: semantic/loaddefs
 331 ;; generated-autoload-load-name: "semantic/symref/list"
 332 ;; End:
 333
 334 ;; arch-tag: e355d9c6-26e0-42d1-9bf1-f4801a54fffa
 335 ;;; semantic/symref/list.el ends here