[bpt/emacs.git] / lisp / cedet / semantic / symref / list.el

;;; semantic/symref/list.el --- Symref Output List UI.

;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <eric@siege-engine.com>

;; This file is part of GNU Emacs.

;; 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 2, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; Provide a simple user facing API to finding symbol references.
;;
;; This UI will is the base of some refactoring tools.  For any
;; refactor, the user will execture `semantic-symref' in a tag.  Once
;; that data is collected, the output will be listed in a buffer.  In
;; the output buffer, the user can then initiate different refactoring
;; operations.
;;
;; NOTE: Need to add some refactoring tools.

(require 'semantic/symref)
(require 'pulse)

;;; Code:

;;;###autoload
(defun semantic-symref ()
  "Find references to the current tag.
This command uses the currently configured references tool within the
current project to find references to the current tag. The
references are the organized by file and the name of the function
they are used in.
Display the references in`semantic-symref-results-mode'"
  (interactive)
  (semantic-fetch-tags)
  (let ((ct (semantic-current-tag))
	(res nil)
	)
    ;; Must have a tag...
    (when (not ct) (error "Place cursor inside tag to be searched for"))
    ;; Check w/ user.
    (when (not (y-or-n-p (format "Find references for %s? " (semantic-tag-name ct))))
      (error "Quit"))
    ;; Gather results and tags
    (message "Gathering References...")
    (setq res (semantic-symref-find-references-by-name (semantic-tag-name ct)))
    (semantic-symref-produce-list-on-results res (semantic-tag-name ct))))

;;;###autoload
(defun semantic-symref-symbol (sym)
  "Find references to the symbol SYM.
This command uses the currently configured references tool within the
current project to find references to the input SYM.  The
references are the organized by file and the name of the function
they are used in.
Display the references in`semantic-symref-results-mode'"
  (interactive (list (car (senator-jump-interactive "Symrefs for: " nil nil t)))
	       )
  (semantic-fetch-tags)
  (let ((res nil)
	)
    ;; Gather results and tags
    (message "Gathering References...")
    (setq res (semantic-symref-find-references-by-name sym))
    (semantic-symref-produce-list-on-results res sym)))


(defun semantic-symref-produce-list-on-results (res str)
  "Produce a symref list mode buffer on the results RES."
    (when (not res) (error "No references found"))
    (semantic-symref-result-get-tags res t)
    (message "Gathering References...done")
    ;; Build a refrences buffer.
    (let ((buff (get-buffer-create
		 (format "*Symref %s" str)))
	  )
      (switch-to-buffer-other-window buff)
      (set-buffer buff)
      (semantic-symref-results-mode res))
    )

;;; RESULTS MODE
;;
(defgroup semantic-symref-results-mode nil
  "Symref Results group."
  :group 'semantic)

(defvar semantic-symref-results-mode-map
  (let ((km (make-sparse-keymap)))
    (define-key km "\C-i" 'forward-button)
    (define-key km "\M-C-i" 'backward-button)
    (define-key km " " 'push-button)
    (define-key km "-" 'semantic-symref-list-toggle-showing)
    (define-key km "=" 'semantic-symref-list-toggle-showing)
    (define-key km "+" 'semantic-symref-list-toggle-showing)
    (define-key km "n" 'semantic-symref-list-next-line)
    (define-key km "p" 'semantic-symref-list-prev-line)
    (define-key km "q" 'semantic-symref-hide-buffer)
    km)
  "Keymap used in `semantic-symref-results-mode'.")

(defcustom semantic-symref-results-mode-hook nil
  "*Hook run when `semantic-symref-results-mode' starts."
  :group 'semantic-symref
  :type 'hook)

(defvar semantic-symref-current-results nil
  "The current results in a results mode buffer.")

(defun semantic-symref-results-mode (results)
  "Major-mode for displaying Semantic Symbol Reference RESULTS.
RESULTS is an object of class `semantic-symref-results'."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'semantic-symref-results-mode
        mode-name "Symref"
	)
  (use-local-map semantic-symref-results-mode-map)
  (set (make-local-variable 'semantic-symref-current-results)
       results)
  (semantic-symref-results-dump results)
  (goto-char (point-min))
  (buffer-disable-undo)
  (set (make-local-variable 'font-lock-global-modes) nil)
  (font-lock-mode -1)
  (run-hooks 'semantic-symref-results-mode-hook)
  )

(defun semantic-symref-hide-buffer ()
  "Hide buffer with sematinc-symref results"
  (interactive)
  (bury-buffer))

(defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype
  "*Function to use when creating items in Imenu.
Some useful functions are found in `semantic-format-tag-functions'."
  :group 'semantic-symref
  :type semantic-format-tag-custom-list)

(defun semantic-symref-results-dump (results)
  "Dump the RESULTS into the current buffer."
  ;; Get ready for the insert.
  (toggle-read-only -1)
  (erase-buffer)

  ;; Insert the contents.
  (let ((lastfile nil)
	)
    (dolist (T (oref results :hit-tags))

      (when (not (equal lastfile (semantic-tag-file-name T)))
	(setq lastfile (semantic-tag-file-name T))
	(insert-button lastfile
		       'mouse-face 'custom-button-pressed-face
		       'action 'semantic-symref-rb-goto-file
		       'tag T
		       )
	(insert "\n"))

      (insert "  ")
      (insert-button "[+]"
		     'mouse-face 'highlight
		     'face nil
		     'action 'semantic-symref-rb-toggle-expand-tag
		     'tag T
		     'state 'closed)
      (insert " ")
      (insert-button (funcall semantic-symref-results-summary-function
			      T nil t)
		     'mouse-face 'custom-button-pressed-face
		     'face nil
		     'action 'semantic-symref-rb-goto-tag
		     'tag T)
      (insert "\n")

      ))

  ;; Clean up the mess
  (toggle-read-only 1)
  (set-buffer-modified-p nil)
  )

;;; Commands for semantic-symref-results
;;
(defun semantic-symref-list-toggle-showing ()
  "Toggle showing the contents below the current line."
  (interactive)
  (beginning-of-line)
  (when (re-search-forward "\\[[-+]\\]" (point-at-eol) t)
    (forward-char -1)
    (push-button)))

(defun semantic-symref-rb-toggle-expand-tag (&optional button)
  "Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
  (interactive)
  (let* ((tag (button-get button 'tag))
	 (buff (semantic-tag-buffer tag))
	 (hits (semantic--tag-get-property tag :hit))
	 (state (button-get button 'state))
	 (text nil)
	 )
    (cond
     ((eq state 'closed)
      (toggle-read-only -1)
      (save-excursion
	(set-buffer buff)
	(dolist (H hits)
	  (goto-char (point-min))
	  (forward-line (1- H))
	  (beginning-of-line)
	  (back-to-indentation)
	  (setq text (cons (buffer-substring (point) (point-at-eol)) text)))
	(setq text (nreverse text))
	)
      (goto-char (button-start button))
      (forward-char 1)
      (delete-char 1)
      (insert "-")
      (button-put button 'state 'open)
      (save-excursion
	(end-of-line)
	(while text
	(insert "\n")
	  (insert "    ")
	  (insert-button (car text)
			 'mouse-face 'highlight
			 'face nil
			 'action 'semantic-symref-rb-goto-match
			 'tag tag
			 'line (car hits))
	  (setq text (cdr text)
		hits (cdr hits))))
      (toggle-read-only 1)
      )
     ((eq state 'open)
      (toggle-read-only -1)
      (button-put button 'state 'closed)
      ;; Delete the various bits.
      (goto-char (button-start button))
      (forward-char 1)
      (delete-char 1)
      (insert "+")
      (save-excursion
	(end-of-line)
	(forward-char 1)
	(delete-region (point)
		       (save-excursion
			 (forward-char 1)
			 (forward-line (length hits))
			 (point))))
      (toggle-read-only 1)
      )
     ))
  )

(defun semantic-symref-rb-goto-file (&optional button)
  "Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
  (let* ((tag (button-get button 'tag))
	 (buff (semantic-tag-buffer tag))
	 (win (selected-window))
	 )
    (switch-to-buffer-other-window buff)
    (pulse-momentary-highlight-one-line (point))
    (when (eq last-command-event ?\s) (select-window win))
    ))


(defun semantic-symref-rb-goto-tag (&optional button)
  "Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
  (interactive)
  (let* ((tag (button-get button 'tag))
	 (buff (semantic-tag-buffer tag))
	 (win (selected-window))
	 )
    (switch-to-buffer-other-window buff)
    (semantic-go-to-tag tag)
    (pulse-momentary-highlight-one-line (point))
    (when (eq last-command-event ?\s) (select-window win))
    )
  )

(defun semantic-symref-rb-goto-match (&optional button)
  "Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
  (interactive)
  (let* ((tag (button-get button 'tag))
	 (line (button-get button 'line))
	 (buff (semantic-tag-buffer tag))
	 (win (selected-window))
	 )
    (switch-to-buffer-other-window buff)
    (with-no-warnings (goto-line line))
    (pulse-momentary-highlight-one-line (point))
    (when (eq last-command-event ?\s) (select-window win))
    )
  )

(defun semantic-symref-list-next-line ()
  "Next line in `semantic-symref-results-mode'."
  (interactive)
  (forward-line 1)
  (back-to-indentation))

(defun semantic-symref-list-prev-line ()
  "Next line in `semantic-symref-results-mode'."
  (interactive)
  (forward-line -1)
  (back-to-indentation))

(provide 'semantic/symref/list)

;; Local variables:
;; generated-autoload-file: "../loaddefs.el"
;; generated-autoload-feature: semantic/loaddefs
;; generated-autoload-load-name: "semantic/symref/list"
;; End:

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