Commit | Line | Data |
---|---|---|
a0690282 | 1 | ;;; semantic/util-modes.el --- Semantic minor modes |
7a0e7d33 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc. |
7a0e7d33 CY |
4 | |
5 | ;; Authors: Eric M. Ludlam <zappo@gnu.org> | |
6 | ;; David Ponce <david@dponce.com> | |
7 | ;; Keywords: syntax | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ;; | |
26 | ;; Semantic utility minor modes. | |
27 | ;; | |
28 | ||
29 | ;;; Code: | |
672eb710 SM |
30 | |
31 | ;; FIXME: compiling util-modes.el seems to require loading util-modes.el, | |
32 | ;; so if the previous compilation generated a file that fails to load, | |
33 | ;; recompiling fails to fix the problem. | |
7a0e7d33 CY |
34 | (require 'semantic) |
35 | ||
7a0e7d33 CY |
36 | ;;; Group for all semantic enhancing modes |
37 | (defgroup semantic-modes nil | |
38 | "Minor modes associated with the Semantic architecture." | |
39 | :group 'semantic) | |
40 | ||
41 | ;;;; | |
42 | ;;;; Semantic minor modes stuff | |
43 | ;;;; | |
44 | (defcustom semantic-update-mode-line t | |
b90caf50 | 45 | "If non-nil, show enabled minor modes in the mode line. |
7a0e7d33 CY |
46 | Only minor modes that are not turned on globally are shown in the mode |
47 | line." | |
48 | :group 'semantic | |
49 | :type 'boolean | |
50 | :require 'semantic/util-modes | |
51 | :initialize 'custom-initialize-default | |
52 | :set (lambda (sym val) | |
53 | (set-default sym val) | |
54 | ;; Update status of all Semantic enabled buffers | |
672eb710 | 55 | (semantic-mode-line-update))) |
7a0e7d33 CY |
56 | |
57 | (defcustom semantic-mode-line-prefix | |
b90caf50 CY |
58 | (propertize "S" 'face 'bold) |
59 | "Prefix added to minor mode indicators in the mode line." | |
7a0e7d33 CY |
60 | :group 'semantic |
61 | :type 'string | |
62 | :require 'semantic/util-modes | |
63 | :initialize 'custom-initialize-default) | |
64 | ||
672eb710 SM |
65 | (defvar semantic-minor-modes-format nil |
66 | "Mode line format showing Semantic minor modes which are locally enabled. | |
7a0e7d33 | 67 | It is displayed in the mode line.") |
672eb710 | 68 | (put 'semantic-minor-modes-format 'risky-local-variable t) |
7a0e7d33 CY |
69 | |
70 | (defvar semantic-minor-mode-alist nil | |
71 | "Alist saying how to show Semantic minor modes in the mode line. | |
72 | Like variable `minor-mode-alist'.") | |
73 | ||
74 | (defun semantic-mode-line-update () | |
672eb710 | 75 | "Update mode line format of Semantic minor modes. |
7a0e7d33 | 76 | Only minor modes that are locally enabled are shown in the mode line." |
672eb710 SM |
77 | (setq semantic-minor-modes-format nil) |
78 | (dolist (x semantic-minor-mode-alist) | |
79 | (setq minor-mode-alist (delq (assq (car x) minor-mode-alist) | |
80 | minor-mode-alist))) | |
81 | (when semantic-update-mode-line | |
82 | (let ((locals '())) | |
83 | ;; Select the minor modes that aren't enabled globally and who | |
84 | ;; have a non-empty "name". | |
85 | (dolist (x semantic-minor-mode-alist) | |
86 | (unless (or (memq (car x) semantic-init-hook) | |
87 | (not (string-match "^[ ]*\\(.+\\)" (cadr x)))) | |
88 | (push (list (car x) (concat "/" (match-string 1 (cadr x)))) locals))) | |
89 | ;; Then build the format spec. | |
90 | (when locals | |
91 | (let ((prefix (if (string-match "^[ ]*\\(.+\\)" | |
92 | semantic-mode-line-prefix) | |
93 | (match-string 1 semantic-mode-line-prefix) | |
94 | "S"))) | |
95 | (setq semantic-minor-modes-format | |
96 | `((:eval (if (or ,@(mapcar 'car locals)) | |
97 | ,(concat " " prefix))))) | |
98 | ;; It would be easier to just put `locals' inside | |
99 | ;; semantic-minor-modes-format, but then things like | |
100 | ;; mode-line-minor-mode-help can't find the right major mode | |
101 | ;; any more. So instead, we carefully put the minor modes | |
102 | ;; in minor-mode-alist. | |
103 | (let* ((elem (or (assq 'semantic-minor-modes-format | |
104 | minor-mode-alist) | |
105 | ;; FIXME: This entry is meaningless for | |
106 | ;; mode-line-minor-mode-help. | |
107 | '(semantic-minor-modes-format | |
108 | semantic-minor-modes-format))) | |
109 | (tail (or (memq elem minor-mode-alist) | |
110 | (setq minor-mode-alist | |
111 | (cons elem minor-mode-alist))))) | |
fac916bf | 112 | (setcdr tail (nconc locals (cdr tail))))))))) |
7a0e7d33 CY |
113 | |
114 | (defun semantic-desktop-ignore-this-minor-mode (buffer) | |
115 | "Installed as a minor-mode initializer for Desktop mode. | |
116 | BUFFER is the buffer to not initialize a Semantic minor mode in." | |
117 | nil) | |
118 | ||
cb7f3653 | 119 | (defun semantic-add-minor-mode (toggle name) |
7a0e7d33 CY |
120 | "Register a new Semantic minor mode. |
121 | TOGGLE is a symbol which is the name of a buffer-local variable that | |
122 | is toggled on or off to say whether the minor mode is active or not. | |
123 | It is also an interactive function to toggle the mode. | |
124 | ||
125 | NAME specifies what will appear in the mode line when the minor mode | |
126 | is active. NAME should be either a string starting with a space, or a | |
cb7f3653 | 127 | symbol whose value is such a string." |
7a0e7d33 CY |
128 | ;; Record how to display this minor mode in the mode line |
129 | (let ((mm (assq toggle semantic-minor-mode-alist))) | |
130 | (if mm | |
131 | (setcdr mm (list name)) | |
132 | (setq semantic-minor-mode-alist (cons (list toggle name) | |
133 | semantic-minor-mode-alist)))) | |
672eb710 | 134 | (semantic-mode-line-update) |
7a0e7d33 CY |
135 | |
136 | ;; Semantic minor modes don't work w/ Desktop restore. | |
137 | ;; This line will disable this minor mode from being restored | |
138 | ;; by Desktop. | |
139 | (when (boundp 'desktop-minor-mode-handlers) | |
140 | (add-to-list 'desktop-minor-mode-handlers | |
672eb710 | 141 | (cons toggle 'semantic-desktop-ignore-this-minor-mode)))) |
7a0e7d33 CY |
142 | |
143 | (defun semantic-toggle-minor-mode-globally (mode &optional arg) | |
144 | "Toggle minor mode MODE in every Semantic enabled buffer. | |
145 | Return non-nil if MODE is turned on in every Semantic enabled buffer. | |
cb7f3653 SM |
146 | If ARG is positive, enable, if it is negative, disable. |
147 | MODE must be a valid minor mode defined in `minor-mode-alist' and must be | |
148 | too an interactive function used to toggle the mode." | |
149 | ;; FIXME: All callers should pass a -1 or +1 argument. | |
672eb710 SM |
150 | (or (and (fboundp mode) (or (assq mode minor-mode-alist) ;Needed? |
151 | (assq mode semantic-minor-mode-alist))) | |
7a0e7d33 | 152 | (error "Semantic minor mode %s not found" mode)) |
cb7f3653 | 153 | ;; Add or remove the MODE toggle function from `semantic-init-hook'. |
7a0e7d33 CY |
154 | (cond |
155 | ;; Turn off if ARG < 0 | |
cb7f3653 | 156 | ((< arg 0) (remove-hook 'semantic-init-hook mode)) |
7a0e7d33 | 157 | ;; Turn on if ARG > 0 |
cb7f3653 | 158 | ((> arg 0) (add-hook 'semantic-init-hook mode)) |
7a0e7d33 CY |
159 | ;; Otherwise just check MODE state |
160 | (t | |
cb7f3653 | 161 | (error "semantic-toggle-minor-mode-globally: arg should be -1 or 1"))) |
672eb710 SM |
162 | ;; Update the minor mode format. |
163 | (semantic-mode-line-update) | |
cb7f3653 SM |
164 | ;; Then turn MODE on or off in every Semantic enabled buffer. |
165 | (semantic-map-buffers #'(lambda () (funcall mode arg)))) | |
7a0e7d33 CY |
166 | \f |
167 | ;;;; | |
168 | ;;;; Minor mode to highlight areas that a user edits. | |
169 | ;;;; | |
170 | ||
a0690282 | 171 | ;;;###autoload |
cb7f3653 | 172 | (define-minor-mode global-semantic-highlight-edits-mode |
7a0e7d33 | 173 | "Toggle global use of option `semantic-highlight-edits-mode'. |
cb7f3653 SM |
174 | If ARG is positive or nil, enable, if it is negative, disable." |
175 | :global t :group 'semantic :group 'semantic-modes | |
176 | (semantic-toggle-minor-mode-globally | |
177 | 'semantic-highlight-edits-mode | |
178 | (if global-semantic-highlight-edits-mode 1 -1))) | |
7a0e7d33 CY |
179 | |
180 | (defcustom semantic-highlight-edits-mode-hook nil | |
b90caf50 | 181 | "Hook run at the end of function `semantic-highlight-edits-mode'." |
7a0e7d33 CY |
182 | :group 'semantic |
183 | :type 'hook) | |
184 | ||
185 | (defface semantic-highlight-edits-face | |
186 | '((((class color) (background dark)) | |
187 | ;; Put this back to something closer to black later. | |
188 | (:background "gray20")) | |
189 | (((class color) (background light)) | |
190 | (:background "gray90"))) | |
b90caf50 | 191 | "Face used to show dirty tokens in `semantic-highlight-edits-mode'." |
7a0e7d33 CY |
192 | :group 'semantic-faces) |
193 | ||
194 | (defun semantic-highlight-edits-new-change-hook-fcn (overlay) | |
195 | "Function set into `semantic-edits-new-change-hook'. | |
196 | Argument OVERLAY is the overlay created to mark the change. | |
197 | This function will set the face property on this overlay." | |
198 | (semantic-overlay-put overlay 'face 'semantic-highlight-edits-face)) | |
199 | ||
200 | (defvar semantic-highlight-edits-mode-map | |
201 | (let ((km (make-sparse-keymap))) | |
202 | km) | |
203 | "Keymap for highlight-edits minor mode.") | |
204 | ||
cb7f3653 SM |
205 | ;;;###autoload |
206 | (define-minor-mode semantic-highlight-edits-mode | |
207 | "Minor mode for highlighting changes made in a buffer. | |
208 | Changes are tracked by semantic so that the incremental parser can work | |
209 | properly. | |
210 | This mode will highlight those changes as they are made, and clear them | |
211 | when the incremental parser accounts for those edits. | |
212 | With prefix argument ARG, turn on if positive, otherwise off. The | |
213 | minor mode can be turned on only if semantic feature is available and | |
214 | the current buffer was set up for parsing. Return non-nil if the | |
7a0e7d33 | 215 | minor mode is enabled." |
cb7f3653 | 216 | :keymap semantic-highlight-edits-mode-map |
7a0e7d33 CY |
217 | (if semantic-highlight-edits-mode |
218 | (if (not (and (featurep 'semantic) (semantic-active-p))) | |
219 | (progn | |
220 | ;; Disable minor mode if semantic stuff not available | |
221 | (setq semantic-highlight-edits-mode nil) | |
222 | (error "Buffer %s was not set up for parsing" | |
223 | (buffer-name))) | |
237b5653 SM |
224 | (semantic-make-local-hook 'semantic-edits-new-change-functions) |
225 | (add-hook 'semantic-edits-new-change-functions | |
cb7f3653 | 226 | 'semantic-highlight-edits-new-change-hook-fcn nil t)) |
7a0e7d33 | 227 | ;; Remove hooks |
237b5653 | 228 | (remove-hook 'semantic-edits-new-change-functions |
672eb710 | 229 | 'semantic-highlight-edits-new-change-hook-fcn t))) |
7a0e7d33 CY |
230 | |
231 | (semantic-add-minor-mode 'semantic-highlight-edits-mode | |
cb7f3653 | 232 | "e") |
7a0e7d33 CY |
233 | \f |
234 | ;;;; | |
235 | ;;;; Minor mode to show unmatched-syntax elements | |
236 | ;;;; | |
a0690282 CY |
237 | |
238 | ;;;###autoload | |
cb7f3653 | 239 | (define-minor-mode global-semantic-show-unmatched-syntax-mode |
7a0e7d33 | 240 | "Toggle global use of option `semantic-show-unmatched-syntax-mode'. |
cb7f3653 SM |
241 | If ARG is positive or nil, enable, if it is negative, disable." |
242 | :global t :group 'semantic :group 'semantic-modes | |
243 | ;; Not needed because it's autoloaded instead. | |
244 | ;; :require 'semantic/util-modes | |
245 | (semantic-toggle-minor-mode-globally | |
246 | 'semantic-show-unmatched-syntax-mode | |
247 | (if global-semantic-show-unmatched-syntax-mode 1 -1))) | |
7a0e7d33 CY |
248 | |
249 | (defcustom semantic-show-unmatched-syntax-mode-hook nil | |
b90caf50 | 250 | "Hook run at the end of function `semantic-show-unmatched-syntax-mode'." |
7a0e7d33 CY |
251 | :group 'semantic |
252 | :type 'hook) | |
253 | ||
254 | (defface semantic-unmatched-syntax-face | |
255 | '((((class color) (background dark)) | |
256 | (:underline "red")) | |
257 | (((class color) (background light)) | |
258 | (:underline "red"))) | |
b90caf50 | 259 | "Face used to show unmatched syntax in. |
db9e401b | 260 | The face is used in `semantic-show-unmatched-syntax-mode'." |
7a0e7d33 CY |
261 | :group 'semantic-faces) |
262 | ||
263 | (defsubst semantic-unmatched-syntax-overlay-p (overlay) | |
264 | "Return non-nil if OVERLAY is an unmatched syntax one." | |
265 | (eq (semantic-overlay-get overlay 'semantic) 'unmatched)) | |
266 | ||
267 | (defun semantic-showing-unmatched-syntax-p () | |
268 | "Return non-nil if an unmatched syntax overlay was found in buffer." | |
269 | (let ((ol (semantic-overlays-in (point-min) (point-max))) | |
270 | found) | |
271 | (while (and ol (not found)) | |
272 | (setq found (semantic-unmatched-syntax-overlay-p (car ol)) | |
273 | ol (cdr ol))) | |
274 | found)) | |
275 | ||
276 | (defun semantic-show-unmatched-lex-tokens-fetch () | |
277 | "Fetch a list of unmatched lexical tokens from the current buffer. | |
278 | Uses the overlays which have accurate bounds, and rebuilds what was | |
279 | originally passed in." | |
280 | (let ((ol (semantic-overlays-in (point-min) (point-max))) | |
281 | (ustc nil)) | |
282 | (while ol | |
283 | (if (semantic-unmatched-syntax-overlay-p (car ol)) | |
284 | (setq ustc (cons (cons 'thing | |
285 | (cons (semantic-overlay-start (car ol)) | |
286 | (semantic-overlay-end (car ol)))) | |
287 | ustc))) | |
288 | (setq ol (cdr ol))) | |
289 | (nreverse ustc)) | |
290 | ) | |
291 | ||
292 | (defun semantic-clean-unmatched-syntax-in-region (beg end) | |
293 | "Remove all unmatched syntax overlays between BEG and END." | |
294 | (let ((ol (semantic-overlays-in beg end))) | |
295 | (while ol | |
296 | (if (semantic-unmatched-syntax-overlay-p (car ol)) | |
297 | (semantic-overlay-delete (car ol))) | |
298 | (setq ol (cdr ol))))) | |
299 | ||
300 | (defsubst semantic-clean-unmatched-syntax-in-buffer () | |
301 | "Remove all unmatched syntax overlays found in current buffer." | |
302 | (semantic-clean-unmatched-syntax-in-region | |
303 | (point-min) (point-max))) | |
304 | ||
305 | (defsubst semantic-clean-token-of-unmatched-syntax (token) | |
306 | "Clean the area covered by TOKEN of unmatched syntax markers." | |
307 | (semantic-clean-unmatched-syntax-in-region | |
308 | (semantic-tag-start token) (semantic-tag-end token))) | |
309 | ||
310 | (defun semantic-show-unmatched-syntax (syntax) | |
311 | "Function set into `semantic-unmatched-syntax-hook'. | |
312 | This will highlight elements in SYNTAX as unmatched syntax." | |
313 | ;; This is called when `semantic-show-unmatched-syntax-mode' is | |
314 | ;; enabled. Highlight the unmatched syntax, and then add a semantic | |
315 | ;; property to that overlay so we can add it to the official list of | |
316 | ;; semantic supported overlays. This gets it cleaned up for errors, | |
317 | ;; buffer cleaning, and the like. | |
318 | (semantic-clean-unmatched-syntax-in-buffer) ;Clear previous highlighting | |
319 | (if syntax | |
320 | (let (o) | |
321 | (while syntax | |
322 | (setq o (semantic-make-overlay (semantic-lex-token-start (car syntax)) | |
323 | (semantic-lex-token-end (car syntax)))) | |
324 | (semantic-overlay-put o 'semantic 'unmatched) | |
325 | (semantic-overlay-put o 'face 'semantic-unmatched-syntax-face) | |
326 | (setq syntax (cdr syntax)))) | |
327 | )) | |
328 | ||
329 | (defun semantic-next-unmatched-syntax (point &optional bound) | |
330 | "Find the next overlay for unmatched syntax after POINT. | |
331 | Do not search past BOUND if non-nil." | |
332 | (save-excursion | |
333 | (goto-char point) | |
334 | (let ((os point) (ol nil)) | |
335 | (while (and os (< os (or bound (point-max))) (not ol)) | |
336 | (setq os (semantic-overlay-next-change os)) | |
337 | (when os | |
338 | ;; Get overlays at position | |
339 | (setq ol (semantic-overlays-at os)) | |
340 | ;; find the overlay that belongs to semantic | |
341 | ;; and starts at the found position. | |
342 | (while (and ol (listp ol)) | |
343 | (and (semantic-unmatched-syntax-overlay-p (car ol)) | |
344 | (setq ol (car ol))) | |
345 | (if (listp ol) | |
346 | (setq ol (cdr ol)))))) | |
347 | ol))) | |
348 | ||
349 | (defvar semantic-show-unmatched-syntax-mode-map | |
350 | (let ((km (make-sparse-keymap))) | |
351 | (define-key km "\C-c,`" 'semantic-show-unmatched-syntax-next) | |
352 | km) | |
353 | "Keymap for command `semantic-show-unmatched-syntax-mode'.") | |
354 | ||
cb7f3653 SM |
355 | ;;;###autoload |
356 | (define-minor-mode semantic-show-unmatched-syntax-mode | |
357 | "Minor mode to highlight unmatched lexical syntax tokens. | |
358 | When a parser executes, some elements in the buffer may not match any | |
359 | parser rules. These text characters are considered unmatched syntax. | |
360 | Often time, the display of unmatched syntax can expose coding | |
361 | problems before the compiler is run. | |
362 | ||
363 | With prefix argument ARG, turn on if positive, otherwise off. The | |
364 | minor mode can be turned on only if semantic feature is available and | |
365 | the current buffer was set up for parsing. Return non-nil if the | |
366 | minor mode is enabled. | |
367 | ||
368 | \\{semantic-show-unmatched-syntax-mode-map}" | |
369 | :keymap semantic-show-unmatched-syntax-mode-map | |
7a0e7d33 CY |
370 | (if semantic-show-unmatched-syntax-mode |
371 | (if (not (and (featurep 'semantic) (semantic-active-p))) | |
372 | (progn | |
373 | ;; Disable minor mode if semantic stuff not available | |
374 | (setq semantic-show-unmatched-syntax-mode nil) | |
375 | (error "Buffer %s was not set up for parsing" | |
376 | (buffer-name))) | |
377 | ;; Add hooks | |
378 | (semantic-make-local-hook 'semantic-unmatched-syntax-hook) | |
379 | (add-hook 'semantic-unmatched-syntax-hook | |
380 | 'semantic-show-unmatched-syntax nil t) | |
381 | (semantic-make-local-hook 'semantic-pre-clean-token-hooks) | |
382 | (add-hook 'semantic-pre-clean-token-hooks | |
383 | 'semantic-clean-token-of-unmatched-syntax nil t) | |
384 | ;; Show unmatched syntax elements | |
385 | (if (not (semantic--umatched-syntax-needs-refresh-p)) | |
386 | (semantic-show-unmatched-syntax | |
387 | (semantic-unmatched-syntax-tokens)))) | |
388 | ;; Remove hooks | |
389 | (remove-hook 'semantic-unmatched-syntax-hook | |
390 | 'semantic-show-unmatched-syntax t) | |
391 | (remove-hook 'semantic-pre-clean-token-hooks | |
392 | 'semantic-clean-token-of-unmatched-syntax t) | |
393 | ;; Cleanup unmatched-syntax highlighting | |
672eb710 | 394 | (semantic-clean-unmatched-syntax-in-buffer))) |
7a0e7d33 CY |
395 | |
396 | (semantic-add-minor-mode 'semantic-show-unmatched-syntax-mode | |
cb7f3653 | 397 | "u") |
7a0e7d33 CY |
398 | |
399 | (defun semantic-show-unmatched-syntax-next () | |
400 | "Move forward to the next occurrence of unmatched syntax." | |
401 | (interactive) | |
402 | (let ((o (semantic-next-unmatched-syntax (point)))) | |
403 | (if o | |
404 | (goto-char (semantic-overlay-start o))))) | |
405 | ||
406 | \f | |
407 | ;;;; | |
408 | ;;;; Minor mode to display the parser state in the modeline. | |
409 | ;;;; | |
410 | ||
a0690282 | 411 | ;;;###autoload |
cb7f3653 | 412 | (define-minor-mode global-semantic-show-parser-state-mode |
7a0e7d33 | 413 | "Toggle global use of option `semantic-show-parser-state-mode'. |
cb7f3653 SM |
414 | If ARG is positive or nil, enable, if it is negative, disable." |
415 | :global t :group 'semantic | |
416 | ;; Not needed because it's autoloaded instead. | |
417 | ;; :require 'semantic/util-modes | |
418 | (semantic-toggle-minor-mode-globally | |
419 | 'semantic-show-parser-state-mode | |
420 | (if global-semantic-show-parser-state-mode 1 -1))) | |
7a0e7d33 CY |
421 | |
422 | (defcustom semantic-show-parser-state-mode-hook nil | |
b90caf50 | 423 | "Hook run at the end of function `semantic-show-parser-state-mode'." |
7a0e7d33 CY |
424 | :group 'semantic |
425 | :type 'hook) | |
426 | ||
427 | (defvar semantic-show-parser-state-mode-map | |
428 | (let ((km (make-sparse-keymap))) | |
429 | km) | |
430 | "Keymap for show-parser-state minor mode.") | |
431 | ||
cb7f3653 SM |
432 | ;;;###autoload |
433 | (define-minor-mode semantic-show-parser-state-mode | |
434 | "Minor mode for displaying parser cache state in the modeline. | |
435 | The cache can be in one of three states. They are | |
436 | Up to date, Partial reparse needed, and Full reparse needed. | |
437 | The state is indicated in the modeline with the following characters: | |
438 | `-' -> The cache is up to date. | |
439 | `!' -> The cache requires a full update. | |
440 | `~' -> The cache needs to be incrementally parsed. | |
fac916bf | 441 | `%' -> The cache is not currently parsable. |
cb7f3653 SM |
442 | `@' -> Auto-parse in progress (not set here.) |
443 | With prefix argument ARG, turn on if positive, otherwise off. The | |
444 | minor mode can be turned on only if semantic feature is available and | |
445 | the current buffer was set up for parsing. Return non-nil if the | |
7a0e7d33 | 446 | minor mode is enabled." |
cb7f3653 | 447 | :keymap semantic-show-parser-state-mode-map |
7a0e7d33 CY |
448 | (if semantic-show-parser-state-mode |
449 | (if (not (and (featurep 'semantic) (semantic-active-p))) | |
450 | (progn | |
451 | ;; Disable minor mode if semantic stuff not available | |
452 | (setq semantic-show-parser-state-mode nil) | |
453 | (error "Buffer %s was not set up for parsing" | |
454 | (buffer-name))) | |
455 | ;; Set up mode line | |
456 | ||
457 | (when (not | |
458 | (memq 'semantic-show-parser-state-string mode-line-modified)) | |
459 | (setq mode-line-modified | |
460 | (append mode-line-modified | |
461 | '(semantic-show-parser-state-string)))) | |
462 | ;; Add hooks | |
237b5653 SM |
463 | (semantic-make-local-hook 'semantic-edits-new-change-functions) |
464 | (add-hook 'semantic-edits-new-change-functions | |
7a0e7d33 | 465 | 'semantic-show-parser-state-marker nil t) |
b733e9bc CY |
466 | (semantic-make-local-hook 'semantic-edits-incremental-reparse-failed-hook) |
467 | (add-hook 'semantic-edits-incremental-reparse-failed-hook | |
7a0e7d33 CY |
468 | 'semantic-show-parser-state-marker nil t) |
469 | (semantic-make-local-hook 'semantic-after-partial-cache-change-hook) | |
470 | (add-hook 'semantic-after-partial-cache-change-hook | |
471 | 'semantic-show-parser-state-marker nil t) | |
472 | (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) | |
473 | (add-hook 'semantic-after-toplevel-cache-change-hook | |
474 | 'semantic-show-parser-state-marker nil t) | |
475 | (semantic-show-parser-state-marker) | |
476 | ||
477 | (semantic-make-local-hook 'semantic-before-auto-parse-hooks) | |
478 | (add-hook 'semantic-before-auto-parse-hooks | |
479 | 'semantic-show-parser-state-auto-marker nil t) | |
480 | (semantic-make-local-hook 'semantic-after-auto-parse-hooks) | |
481 | (add-hook 'semantic-after-auto-parse-hooks | |
482 | 'semantic-show-parser-state-marker nil t) | |
483 | ||
7cf918c6 CY |
484 | (semantic-make-local-hook 'semantic-before-idle-scheduler-reparse-hook) |
485 | (add-hook 'semantic-before-idle-scheduler-reparse-hook | |
7a0e7d33 | 486 | 'semantic-show-parser-state-auto-marker nil t) |
7cf918c6 CY |
487 | (semantic-make-local-hook 'semantic-after-idle-scheduler-reparse-hook) |
488 | (add-hook 'semantic-after-idle-scheduler-reparse-hook | |
cb7f3653 | 489 | 'semantic-show-parser-state-marker nil t)) |
7a0e7d33 CY |
490 | ;; Remove parts of mode line |
491 | (setq mode-line-modified | |
492 | (delq 'semantic-show-parser-state-string mode-line-modified)) | |
493 | ;; Remove hooks | |
237b5653 | 494 | (remove-hook 'semantic-edits-new-change-functions |
7a0e7d33 | 495 | 'semantic-show-parser-state-marker t) |
b733e9bc | 496 | (remove-hook 'semantic-edits-incremental-reparse-failed-hook |
7a0e7d33 CY |
497 | 'semantic-show-parser-state-marker t) |
498 | (remove-hook 'semantic-after-partial-cache-change-hook | |
499 | 'semantic-show-parser-state-marker t) | |
500 | (remove-hook 'semantic-after-toplevel-cache-change-hook | |
501 | 'semantic-show-parser-state-marker t) | |
502 | ||
503 | (remove-hook 'semantic-before-auto-parse-hooks | |
504 | 'semantic-show-parser-state-auto-marker t) | |
505 | (remove-hook 'semantic-after-auto-parse-hooks | |
506 | 'semantic-show-parser-state-marker t) | |
507 | ||
7cf918c6 | 508 | (remove-hook 'semantic-before-idle-scheduler-reparse-hook |
7a0e7d33 | 509 | 'semantic-show-parser-state-auto-marker t) |
7cf918c6 | 510 | (remove-hook 'semantic-after-idle-scheduler-reparse-hook |
672eb710 | 511 | 'semantic-show-parser-state-marker t))) |
7a0e7d33 CY |
512 | |
513 | (semantic-add-minor-mode 'semantic-show-parser-state-mode | |
cb7f3653 | 514 | "") |
7a0e7d33 CY |
515 | |
516 | (defvar semantic-show-parser-state-string nil | |
517 | "String showing the parser state for this buffer. | |
518 | See `semantic-show-parser-state-marker' for details.") | |
519 | (make-variable-buffer-local 'semantic-show-parser-state-string) | |
520 | ||
521 | (defun semantic-show-parser-state-marker (&rest ignore) | |
522 | "Set `semantic-show-parser-state-string' to indicate parser state. | |
523 | This marker is one of the following: | |
524 | `-' -> The cache is up to date. | |
525 | `!' -> The cache requires a full update. | |
526 | `~' -> The cache needs to be incrementally parsed. | |
fac916bf | 527 | `%' -> The cache is not currently parsable. |
7a0e7d33 CY |
528 | `@' -> Auto-parse in progress (not set here.) |
529 | Arguments IGNORE are ignored, and accepted so this can be used as a hook | |
530 | in many situations." | |
531 | (setq semantic-show-parser-state-string | |
532 | (cond ((semantic-parse-tree-needs-rebuild-p) | |
533 | "!") | |
534 | ((semantic-parse-tree-needs-update-p) | |
535 | "^") | |
536 | ((semantic-parse-tree-unparseable-p) | |
537 | "%") | |
538 | (t | |
539 | "-"))) | |
540 | ;;(message "Setup mode line indicator to [%s]" semantic-show-parser-state-string) | |
672eb710 | 541 | ) |
7a0e7d33 CY |
542 | |
543 | (defun semantic-show-parser-state-auto-marker () | |
544 | "Hook function run before an autoparse. | |
545 | Set up `semantic-show-parser-state-marker' to show `@' | |
546 | to indicate a parse in progress." | |
547 | (unless (semantic-parse-tree-up-to-date-p) | |
548 | (setq semantic-show-parser-state-string "@") | |
7a0e7d33 CY |
549 | ;; For testing. |
550 | ;;(sit-for 1) | |
551 | )) | |
552 | ||
553 | \f | |
554 | ;;;; | |
555 | ;;;; Minor mode to make function decls sticky. | |
556 | ;;;; | |
557 | ||
a0690282 | 558 | ;;;###autoload |
cb7f3653 | 559 | (define-minor-mode global-semantic-stickyfunc-mode |
7a0e7d33 | 560 | "Toggle global use of option `semantic-stickyfunc-mode'. |
cb7f3653 SM |
561 | If ARG is positive or nil, enable, if it is negative, disable." |
562 | :global t :group 'semantic :group 'semantic-modes | |
563 | ;; Not needed because it's autoloaded instead. | |
564 | ;; :require 'semantic/util-modes | |
565 | (semantic-toggle-minor-mode-globally | |
566 | 'semantic-stickyfunc-mode (if global-semantic-stickyfunc-mode 1 -1))) | |
7a0e7d33 CY |
567 | |
568 | (defcustom semantic-stickyfunc-mode-hook nil | |
b90caf50 | 569 | "Hook run at the end of function `semantic-stickyfunc-mode'." |
7a0e7d33 CY |
570 | :group 'semantic |
571 | :type 'hook) | |
572 | ||
573 | (defvar semantic-stickyfunc-mode-map | |
574 | (let ((km (make-sparse-keymap))) | |
575 | (define-key km [ header-line down-mouse-1 ] 'semantic-stickyfunc-menu) | |
576 | km) | |
577 | "Keymap for stickyfunc minor mode.") | |
578 | ||
579 | (defvar semantic-stickyfunc-popup-menu nil | |
580 | "Menu used if the user clicks on the header line used by stickyfunc mode.") | |
581 | ||
582 | (easy-menu-define | |
583 | semantic-stickyfunc-popup-menu | |
584 | semantic-stickyfunc-mode-map | |
585 | "Stickyfunc Menu" | |
586 | '("Stickyfunc Mode" :visible (progn nil) | |
587 | [ "Copy Headerline Tag" senator-copy-tag | |
588 | :active (semantic-current-tag) | |
589 | :help "Copy the current tag to the tag ring"] | |
590 | [ "Kill Headerline Tag" senator-kill-tag | |
591 | :active (semantic-current-tag) | |
592 | :help "Kill tag text to the kill ring, and copy the tag to the tag ring" | |
593 | ] | |
594 | [ "Copy Headerline Tag to Register" senator-copy-tag-to-register | |
595 | :active (semantic-current-tag) | |
596 | :help "Copy the current tag to a register" | |
597 | ] | |
598 | [ "Narrow To Headerline Tag" senator-narrow-to-defun | |
599 | :active (semantic-current-tag) | |
db9e401b | 600 | :help "Narrow to the bounds of the current tag"] |
7a0e7d33 CY |
601 | [ "Fold Headerline Tag" senator-fold-tag-toggle |
602 | :active (semantic-current-tag) | |
603 | :style toggle | |
604 | :selected (let ((tag (semantic-current-tag))) | |
605 | (and tag (semantic-tag-folded-p tag))) | |
606 | :help "Fold the current tag to one line" | |
607 | ] | |
608 | "---" | |
609 | [ "About This Header Line" | |
610 | (lambda () (interactive) | |
611 | (describe-function 'semantic-stickyfunc-mode)) t]) | |
612 | ) | |
613 | ||
7a0e7d33 CY |
614 | (defcustom semantic-stickyfunc-indent-string |
615 | (if (and window-system (not (featurep 'xemacs))) | |
616 | (concat | |
617 | (condition-case nil | |
618 | ;; Test scroll bar location | |
619 | (let ((charwidth (frame-char-width)) | |
620 | (scrollpos (frame-parameter (selected-frame) | |
621 | 'vertical-scroll-bars)) | |
622 | ) | |
623 | (if (or (eq scrollpos 'left) | |
624 | ;; Now wait a minute. If you turn scroll-bar-mode | |
625 | ;; on, then off, the new value is t, not left. | |
626 | ;; Will this mess up older emacs where the default | |
627 | ;; was on the right? I don't think so since they don't | |
628 | ;; support a header line. | |
629 | (eq scrollpos t)) | |
630 | (let ((w (when (boundp 'scroll-bar-width) | |
631 | (symbol-value 'scroll-bar-width)))) | |
632 | ||
633 | (if (not w) | |
634 | (setq w (frame-parameter (selected-frame) | |
635 | 'scroll-bar-width))) | |
636 | ||
637 | ;; in 21.2, the frame parameter is sometimes empty | |
638 | ;; so we need to get the value here. | |
639 | (if (not w) | |
640 | (setq w (+ (get 'scroll-bar-width 'x-frame-parameter) | |
641 | ;; In 21.4, or perhaps 22.1 the x-frame | |
642 | ;; parameter is different from the frame | |
643 | ;; parameter by only 1 pixel. | |
644 | 1))) | |
645 | ||
646 | (if (not w) | |
647 | " " | |
648 | (setq w (+ 2 w)) ; Some sort of border around | |
649 | ; the scrollbar. | |
650 | (make-string (/ w charwidth) ? ))) | |
651 | "")) | |
652 | (error "")) | |
653 | (condition-case nil | |
654 | ;; Test fringe size. | |
655 | (let* ((f (window-fringes)) | |
656 | (fw (car f)) | |
657 | (numspace (/ fw (frame-char-width))) | |
658 | ) | |
659 | (make-string numspace ? )) | |
660 | (error | |
661 | ;; Well, the fancy new Emacs functions failed. Try older | |
662 | ;; tricks. | |
663 | (condition-case nil | |
664 | ;; I'm not so sure what's up with the 21.1-21.3 fringe. | |
665 | ;; It looks to be about 1 space wide. | |
666 | (if (get 'fringe 'face) | |
667 | " " | |
668 | "") | |
669 | (error "")))) | |
670 | ) | |
671 | ;; Not Emacs or a window system means no scrollbar or fringe, | |
672 | ;; and perhaps not even a header line to worry about. | |
673 | "") | |
b90caf50 | 674 | "String used to indent the stickyfunc header. |
7a0e7d33 CY |
675 | Customize this string to match the space used by scrollbars and |
676 | fringe so it does not appear that the code is moving left/right | |
677 | when it lands in the sticky line." | |
678 | :group 'semantic | |
679 | :type 'string) | |
680 | ||
681 | (defvar semantic-stickyfunc-old-hlf nil | |
db9e401b | 682 | "Value of the header line when entering stickyfunc mode.") |
7a0e7d33 CY |
683 | |
684 | (defconst semantic-stickyfunc-header-line-format | |
685 | (cond ((featurep 'xemacs) | |
686 | nil) | |
687 | ((>= emacs-major-version 22) | |
688 | '(:eval (list | |
689 | ;; Magic bit I found on emacswiki. | |
690 | (propertize " " 'display '((space :align-to 0))) | |
691 | (semantic-stickyfunc-fetch-stickyline)))) | |
692 | ((= emacs-major-version 21) | |
693 | '(:eval (list semantic-stickyfunc-indent-string | |
694 | (semantic-stickyfunc-fetch-stickyline)))) | |
695 | (t nil)) | |
db9e401b | 696 | "The header line format used by stickyfunc mode.") |
7a0e7d33 | 697 | |
cb7f3653 SM |
698 | ;;;###autoload |
699 | (define-minor-mode semantic-stickyfunc-mode | |
700 | "Minor mode to show the title of a tag in the header line. | |
701 | Enables/disables making the header line of functions sticky. | |
702 | A function (or other tag class specified by | |
703 | `semantic-stickyfunc-sticky-classes') has a header line, meaning the | |
704 | first line which describes the rest of the construct. This first | |
705 | line is what is displayed in the header line. | |
706 | ||
707 | With prefix argument ARG, turn on if positive, otherwise off. The | |
708 | minor mode can be turned on only if semantic feature is available and | |
709 | the current buffer was set up for parsing. Return non-nil if the | |
710 | minor mode is enabled." | |
711 | ;; Don't need indicator. It's quite visible | |
712 | :keymap semantic-stickyfunc-mode-map | |
7a0e7d33 CY |
713 | (if semantic-stickyfunc-mode |
714 | (progn | |
715 | (unless (and (featurep 'semantic) (semantic-active-p)) | |
716 | ;; Disable minor mode if semantic stuff not available | |
717 | (setq semantic-stickyfunc-mode nil) | |
718 | (error "Buffer %s was not set up for parsing" (buffer-name))) | |
719 | (unless (boundp 'default-header-line-format) | |
720 | ;; Disable if there are no header lines to use. | |
721 | (setq semantic-stickyfunc-mode nil) | |
722 | (error "Sticky Function mode requires Emacs 21")) | |
723 | ;; Enable the mode | |
724 | ;; Save previous buffer local value of header line format. | |
725 | (when (and (local-variable-p 'header-line-format (current-buffer)) | |
726 | (not (eq header-line-format | |
727 | semantic-stickyfunc-header-line-format))) | |
728 | (set (make-local-variable 'semantic-stickyfunc-old-hlf) | |
729 | header-line-format)) | |
cb7f3653 | 730 | (setq header-line-format semantic-stickyfunc-header-line-format)) |
7a0e7d33 CY |
731 | ;; Disable sticky func mode |
732 | ;; Restore previous buffer local value of header line format if | |
733 | ;; the current one is the sticky func one. | |
734 | (when (eq header-line-format semantic-stickyfunc-header-line-format) | |
735 | (kill-local-variable 'header-line-format) | |
736 | (when (local-variable-p 'semantic-stickyfunc-old-hlf (current-buffer)) | |
737 | (setq header-line-format semantic-stickyfunc-old-hlf) | |
672eb710 | 738 | (kill-local-variable 'semantic-stickyfunc-old-hlf))))) |
7a0e7d33 CY |
739 | |
740 | (defvar semantic-stickyfunc-sticky-classes | |
741 | '(function type) | |
db9e401b | 742 | "List of tag classes which stickyfunc will display in the header line.") |
7a0e7d33 CY |
743 | (make-variable-buffer-local 'semantic-stickyfunc-sticky-classes) |
744 | ||
dd9af436 CY |
745 | (defcustom semantic-stickyfunc-show-only-functions-p nil |
746 | "Non-nil means don't show lines that aren't part of a tag. | |
747 | If this is nil, then comments or other text between tags that is | |
748 | 1 line above the top of the current window will be shown." | |
749 | :group 'semantic | |
750 | :type 'boolean) | |
751 | ||
7a0e7d33 CY |
752 | (defun semantic-stickyfunc-tag-to-stick () |
753 | "Return the tag to stick at the current point." | |
754 | (let ((tags (nreverse (semantic-find-tag-by-overlay (point))))) | |
755 | ;; Get rid of non-matching tags. | |
756 | (while (and tags | |
757 | (not (member | |
758 | (semantic-tag-class (car tags)) | |
759 | semantic-stickyfunc-sticky-classes)) | |
760 | ) | |
761 | (setq tags (cdr tags))) | |
762 | (car tags))) | |
763 | ||
764 | (defun semantic-stickyfunc-fetch-stickyline () | |
765 | "Make the function at the top of the current window sticky. | |
db9e401b | 766 | Capture its function declaration, and place it in the header line. |
7a0e7d33 | 767 | If there is no function, disable the header line." |
dd9af436 CY |
768 | (save-excursion |
769 | (goto-char (window-start (selected-window))) | |
770 | (let* ((noshow (bobp)) | |
771 | (str | |
772 | (progn | |
773 | (forward-line -1) | |
774 | (end-of-line) | |
775 | ;; Capture this function | |
776 | (let* ((tag (semantic-stickyfunc-tag-to-stick))) | |
777 | ;; TAG is nil if there was nothing of the appropriate type there. | |
778 | (if (not tag) | |
779 | ;; Set it to be the text under the header line | |
780 | (if noshow | |
781 | "" | |
782 | (if semantic-stickyfunc-show-only-functions-p "" | |
783 | (buffer-substring (point-at-bol) (point-at-eol)) | |
784 | )) | |
785 | ;; Go get the first line of this tag. | |
786 | (goto-char (semantic-tag-start tag)) | |
787 | ;; Klaus Berndl <klaus.berndl@sdm.de>: | |
788 | ;; goto the tag name; this is especially needed for languages | |
789 | ;; like c++ where a often used style is like: | |
790 | ;; void | |
791 | ;; ClassX::methodM(arg1...) | |
792 | ;; { | |
793 | ;; ... | |
794 | ;; } | |
795 | ;; Without going to the tag-name we would get"void" in the | |
796 | ;; header line which is IMHO not really useful | |
797 | (search-forward (semantic-tag-name tag) nil t) | |
798 | (buffer-substring (point-at-bol) (point-at-eol)) | |
799 | )))) | |
800 | (start 0)) | |
801 | (while (string-match "%" str start) | |
802 | (setq str (replace-match "%%" t t str 0) | |
803 | start (1+ (match-end 0))) | |
804 | ) | |
805 | ;; In 21.4 (or 22.1) the header doesn't expand tabs. Hmmmm. | |
806 | ;; We should replace them here. | |
807 | ;; | |
808 | ;; This hack assumes that tabs are kept smartly at tab boundaries | |
809 | ;; instead of in a tab boundary where it might only represent 4 spaces. | |
810 | (while (string-match "\t" str start) | |
811 | (setq str (replace-match " " t t str 0))) | |
812 | str))) | |
7a0e7d33 CY |
813 | |
814 | (defun semantic-stickyfunc-menu (event) | |
815 | "Popup a menu that can help a user understand stickyfunc-mode. | |
816 | Argument EVENT describes the event that caused this function to be called." | |
817 | (interactive "e") | |
818 | (let* ((startwin (selected-window)) | |
819 | (win (car (car (cdr event)))) | |
820 | ) | |
821 | (select-window win t) | |
822 | (save-excursion | |
823 | (goto-char (window-start win)) | |
824 | (sit-for 0) | |
825 | (popup-menu semantic-stickyfunc-popup-menu event) | |
826 | ) | |
827 | (select-window startwin))) | |
828 | ||
829 | ||
830 | (semantic-add-minor-mode 'semantic-stickyfunc-mode | |
cb7f3653 | 831 | "") ;; Don't need indicator. It's quite visible |
7a0e7d33 CY |
832 | |
833 | ||
834 | \f | |
835 | ;;;; | |
836 | ;;;; Minor mode to make highlight the current function | |
837 | ;;;; | |
838 | ||
839 | ;; Highlight the first like of the function we are in if it is different | |
b4dc7d98 | 840 | ;; from the tag going off the top of the screen. |
a0690282 CY |
841 | |
842 | ;;;###autoload | |
cb7f3653 | 843 | (define-minor-mode global-semantic-highlight-func-mode |
7a0e7d33 | 844 | "Toggle global use of option `semantic-highlight-func-mode'. |
cb7f3653 SM |
845 | If ARG is positive or nil, enable, if it is negative, disable." |
846 | :global t :group 'semantic :group 'semantic-modes | |
847 | ;; Not needed because it's autoloaded instead. | |
848 | ;; :require 'semantic/util-modes | |
849 | (semantic-toggle-minor-mode-globally | |
850 | 'semantic-highlight-func-mode | |
851 | (if global-semantic-highlight-func-mode 1 -1))) | |
7a0e7d33 CY |
852 | |
853 | (defcustom semantic-highlight-func-mode-hook nil | |
b90caf50 | 854 | "Hook run at the end of function `semantic-highlight-func-mode'." |
7a0e7d33 CY |
855 | :group 'semantic |
856 | :type 'hook) | |
857 | ||
858 | (defvar semantic-highlight-func-mode-map | |
859 | (let ((km (make-sparse-keymap)) | |
860 | (m3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])) | |
861 | ) | |
862 | (define-key km m3 'semantic-highlight-func-menu) | |
863 | km) | |
864 | "Keymap for highlight-func minor mode.") | |
865 | ||
866 | (defvar semantic-highlight-func-popup-menu nil | |
867 | "Menu used if the user clicks on the header line used by `semantic-highlight-func-mode'.") | |
868 | ||
869 | (easy-menu-define | |
870 | semantic-highlight-func-popup-menu | |
871 | semantic-highlight-func-mode-map | |
872 | "Highlight-Func Menu" | |
873 | '("Highlight-Func Mode" :visible (progn nil) | |
874 | [ "Copy Tag" senator-copy-tag | |
875 | :active (semantic-current-tag) | |
876 | :help "Copy the current tag to the tag ring"] | |
877 | [ "Kill Tag" senator-kill-tag | |
878 | :active (semantic-current-tag) | |
879 | :help "Kill tag text to the kill ring, and copy the tag to the tag ring" | |
880 | ] | |
881 | [ "Copy Tag to Register" senator-copy-tag-to-register | |
882 | :active (semantic-current-tag) | |
883 | :help "Copy the current tag to a register" | |
884 | ] | |
885 | [ "Narrow To Tag" senator-narrow-to-defun | |
886 | :active (semantic-current-tag) | |
db9e401b | 887 | :help "Narrow to the bounds of the current tag"] |
7a0e7d33 CY |
888 | [ "Fold Tag" senator-fold-tag-toggle |
889 | :active (semantic-current-tag) | |
890 | :style toggle | |
891 | :selected (let ((tag (semantic-stickyfunc-tag-to-stick))) | |
892 | (and tag (semantic-tag-folded-p tag))) | |
893 | :help "Fold the current tag to one line" | |
894 | ] | |
895 | "---" | |
896 | [ "About This Tag" semantic-describe-tag t]) | |
897 | ) | |
898 | ||
899 | (defun semantic-highlight-func-menu (event) | |
900 | "Popup a menu that displays things to do to the current tag. | |
901 | Argument EVENT describes the event that caused this function to be called." | |
902 | (interactive "e") | |
903 | (let* ((startwin (selected-window)) | |
904 | (win (semantic-event-window event)) | |
905 | ) | |
906 | (select-window win t) | |
907 | (save-excursion | |
908 | ;(goto-char (window-start win)) | |
909 | (mouse-set-point event) | |
910 | (sit-for 0) | |
911 | (semantic-popup-menu semantic-highlight-func-popup-menu) | |
912 | ) | |
913 | (select-window startwin))) | |
914 | ||
7a0e7d33 CY |
915 | (defvar semantic-highlight-func-ct-overlay nil |
916 | "Overlay used to highlight the tag the cursor is in.") | |
917 | (make-variable-buffer-local 'semantic-highlight-func-ct-overlay) | |
918 | ||
919 | (defface semantic-highlight-func-current-tag-face | |
920 | '((((class color) (background dark)) | |
921 | ;; Put this back to something closer to black later. | |
922 | (:background "gray20")) | |
923 | (((class color) (background light)) | |
924 | (:background "gray90"))) | |
925 | "Face used to show the top of current function." | |
926 | :group 'semantic-faces) | |
927 | ||
a0690282 | 928 | ;;;###autoload |
cb7f3653 | 929 | (define-minor-mode semantic-highlight-func-mode |
7a0e7d33 | 930 | "Minor mode to highlight the first line of the current tag. |
e6e267fc | 931 | Enables/disables making the current function's first line light up. |
7a0e7d33 | 932 | A function (or other tag class specified by |
17e1f4bc | 933 | `semantic-stickyfunc-sticky-classes') is highlighted, meaning the |
7a0e7d33 CY |
934 | first line which describes the rest of the construct. |
935 | ||
17e1f4bc | 936 | See `semantic-stickyfunc-mode' for putting a function in the |
7a0e7d33 CY |
937 | header line. This mode recycles the stickyfunc configuration |
938 | classes list. | |
939 | ||
940 | With prefix argument ARG, turn on if positive, otherwise off. The | |
941 | minor mode can be turned on only if semantic feature is available and | |
942 | the current buffer was set up for parsing. Return non-nil if the | |
943 | minor mode is enabled." | |
cb7f3653 SM |
944 | :lighter nil ;; Don't need indicator. It's quite visible. |
945 | (if semantic-highlight-func-mode | |
946 | (progn | |
947 | (unless (and (featurep 'semantic) (semantic-active-p)) | |
948 | ;; Disable minor mode if semantic stuff not available | |
949 | (setq semantic-highlight-func-mode nil) | |
950 | (error "Buffer %s was not set up for parsing" (buffer-name))) | |
951 | ;; Setup our hook | |
952 | (add-hook 'post-command-hook | |
953 | 'semantic-highlight-func-highlight-current-tag nil t)) | |
954 | ;; Disable highlight func mode | |
955 | (remove-hook 'post-command-hook | |
956 | 'semantic-highlight-func-highlight-current-tag t) | |
957 | (semantic-highlight-func-highlight-current-tag t))) | |
7a0e7d33 CY |
958 | |
959 | (defun semantic-highlight-func-highlight-current-tag (&optional disable) | |
960 | "Highlight the current tag under point. | |
961 | Optional argument DISABLE will turn off any active highlight. | |
962 | If the current tag for this buffer is different from the last time this | |
963 | function was called, move the overlay." | |
964 | (when (and (not (minibufferp)) | |
965 | (or (not semantic-highlight-func-ct-overlay) | |
966 | (eq (semantic-overlay-buffer | |
967 | semantic-highlight-func-ct-overlay) | |
968 | (current-buffer)))) | |
969 | (let* ((tag (semantic-stickyfunc-tag-to-stick)) | |
970 | (ol semantic-highlight-func-ct-overlay)) | |
971 | (when (not ol) | |
972 | ;; No overlay in this buffer. Make one. | |
973 | (setq ol (semantic-make-overlay (point-min) (point-min) | |
974 | (current-buffer) t nil)) | |
975 | (semantic-overlay-put ol 'highlight-func t) | |
976 | (semantic-overlay-put ol 'face 'semantic-highlight-func-current-tag-face) | |
977 | (semantic-overlay-put ol 'keymap semantic-highlight-func-mode-map) | |
978 | (semantic-overlay-put ol 'help-echo | |
979 | "Current Function : mouse-3 - Context menu") | |
980 | (setq semantic-highlight-func-ct-overlay ol) | |
981 | ) | |
982 | ||
db9e401b | 983 | ;; TAG is nil if there was nothing of the appropriate type there. |
7a0e7d33 CY |
984 | (if (or (not tag) disable) |
985 | ;; No tag, make the overlay go away. | |
986 | (progn | |
987 | (semantic-overlay-put ol 'tag nil) | |
988 | (semantic-overlay-move ol (point-min) (point-min) (current-buffer)) | |
989 | ) | |
990 | ||
991 | ;; We have a tag, if it is the same, do nothing. | |
992 | (unless (eq (semantic-overlay-get ol 'tag) tag) | |
993 | (save-excursion | |
994 | (goto-char (semantic-tag-start tag)) | |
995 | (search-forward (semantic-tag-name tag) nil t) | |
996 | (semantic-overlay-put ol 'tag tag) | |
997 | (semantic-overlay-move ol (point-at-bol) (point-at-eol)) | |
998 | ) | |
999 | ) | |
1000 | ))) | |
1001 | nil) | |
1002 | ||
1003 | (semantic-add-minor-mode 'semantic-highlight-func-mode | |
cb7f3653 | 1004 | "") ;; Don't need indicator. It's quite visible |
7a0e7d33 CY |
1005 | |
1006 | (provide 'semantic/util-modes) | |
1007 | ||
a0690282 CY |
1008 | ;; Local variables: |
1009 | ;; generated-autoload-file: "loaddefs.el" | |
a0690282 CY |
1010 | ;; generated-autoload-load-name: "semantic/util-modes" |
1011 | ;; End: | |
1012 | ||
1013 | ;;; semantic/util-modes.el ends here |