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