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