aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2009-09-27 03:36:58 +0000
committerChong Yidong2009-09-27 03:36:58 +0000
commit8bf997efee7b3bc523a4c2bad3a1b228b14e40dd (patch)
tree3bde994dcf96888d6fbb17cdb89e9c17a11f1eb5
parenteb1ac101af57ea1c780cf2142af9f49be7b45b58 (diff)
downloademacs-8bf997efee7b3bc523a4c2bad3a1b228b14e40dd.tar.gz
emacs-8bf997efee7b3bc523a4c2bad3a1b228b14e40dd.zip
* cedet/semantic/idle.el (semantic-idle-scheduler-work-timer):
Change timeout to 1. Doc fix. * cedet/semantic/edit.el (semantic-change-hooks): Add semantic-edits-change-function-handle-changes directly. * cedet/semantic/util.el (semantic--completion-cache): Move to semantic.el. (semantic-symbol-start): Remove unneeded function. * cedet/semantic.el (semantic--completion-cache): Move here from semantic/util.el (semantic-clear-toplevel-cache, semantic--set-buffer-cache) (semantic-fetch-tags): Reset semantic--completion-cache. (semantic-force-refresh): New function (semantic-mode-map): New variable. * cedet/semantic/senator.el: New file. * cedet/ede.el: Fix autoload. (ede-customize-forms-menu): Handle null projects.
-rw-r--r--lisp/ChangeLog24
-rw-r--r--lisp/cedet/ede.el7
-rw-r--r--lisp/cedet/semantic.el158
-rw-r--r--lisp/cedet/semantic/edit.el9
-rw-r--r--lisp/cedet/semantic/idle.el8
-rw-r--r--lisp/cedet/semantic/senator.el888
-rw-r--r--lisp/cedet/semantic/util.el7
7 files changed, 1078 insertions, 23 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0604cdb7018..8e4f9136e92 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,27 @@
12009-09-27 Chong Yidong <cyd@stupidchicken.com>
2
3 * cedet/semantic/idle.el (semantic-idle-scheduler-work-timer):
4 Change timeout to 1. Doc fix.
5
6 * cedet/semantic/edit.el (semantic-change-hooks): Add
7 semantic-edits-change-function-handle-changes directly.
8
9 * cedet/semantic/util.el (semantic--completion-cache): Move to
10 semantic.el.
11 (semantic-symbol-start): Remove unneeded function.
12
13 * cedet/semantic.el (semantic--completion-cache): Move here from
14 semantic/util.el
15 (semantic-clear-toplevel-cache, semantic--set-buffer-cache)
16 (semantic-fetch-tags): Reset semantic--completion-cache.
17 (semantic-force-refresh): New function
18 (semantic-mode-map): New variable.
19
20 * cedet/semantic/senator.el: New file.
21
22 * cedet/ede.el: Fix autoload.
23 (ede-customize-forms-menu): Handle null projects.
24
12009-09-26 Chong Yidong <cyd@stupidchicken.com> 252009-09-26 Chong Yidong <cyd@stupidchicken.com>
2 26
3 * cedet/srecode/mode.el (srecode-menu-bar): Use 27 * cedet/srecode/mode.el (srecode-menu-bar): Use
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 743e3548aa4..48ff9760711 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -706,9 +706,10 @@ Argument MENU-DEF is the definition of the current menu."
706 (easy-menu-create-menu 706 (easy-menu-create-menu
707 "Customize Project" 707 "Customize Project"
708 (let* ((obj (ede-current-project)) 708 (let* ((obj (ede-current-project))
709 (targ (when (slot-boundp obj 'targets) 709 targ)
710 (oref obj targets))))
711 (when obj 710 (when obj
711 (setq targ (when (slot-boundp obj 'targets)
712 (oref obj targets)))
712 ;; Make custom menus for everything here. 713 ;; Make custom menus for everything here.
713 (append (list 714 (append (list
714 (cons (concat "Project " (ede-name obj)) 715 (cons (concat "Project " (ede-name obj))
@@ -759,7 +760,7 @@ If optional argument CURRENT is non-nil, return sub-menu code."
759;;; Mode Declarations 760;;; Mode Declarations
760;; 761;;
761(eval-and-compile 762(eval-and-compile
762 (autoload 'ede-dired-minor-mode "ede-dired" "EDE commands for dired" t)) 763 (autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t))
763 764
764(defun ede-apply-target-options () 765(defun ede-apply-target-options ()
765 "Apply options to the current buffer for the active project/target." 766 "Apply options to the current buffer for the active project/target."
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 9848d5d7965..cb0ac623d54 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -204,6 +204,10 @@ during a flush when the cache is given a new value of nil.")
204(defvar semantic-parser-name "LL" 204(defvar semantic-parser-name "LL"
205 "Optional name of the parser used to parse input stream.") 205 "Optional name of the parser used to parse input stream.")
206(make-variable-buffer-local 'semantic-parser-name) 206(make-variable-buffer-local 'semantic-parser-name)
207
208(defvar semantic--completion-cache nil
209 "Internal variable used by `semantic-complete-symbol'.")
210(make-variable-buffer-local 'semantic--completion-cache)
207 211
208;;; Parse tree state management API 212;;; Parse tree state management API
209;; 213;;
@@ -487,7 +491,8 @@ is requested."
487 491
488 (run-hook-with-args 'semantic-after-toplevel-cache-change-hook 492 (run-hook-with-args 'semantic-after-toplevel-cache-change-hook
489 semantic--buffer-cache) 493 semantic--buffer-cache)
490 ) 494
495 (setq semantic--completion-cache nil))
491 496
492(defvar semantic-bovinate-nonterminal-check-obarray) 497(defvar semantic-bovinate-nonterminal-check-obarray)
493 498
@@ -503,6 +508,7 @@ is requested."
503 (add-hook 'after-change-functions 'semantic-change-function nil t) 508 (add-hook 'after-change-functions 'semantic-change-function nil t)
504 (run-hook-with-args 'semantic-after-toplevel-cache-change-hook 509 (run-hook-with-args 'semantic-after-toplevel-cache-change-hook
505 semantic--buffer-cache) 510 semantic--buffer-cache)
511 (setq semantic--completion-cache nil)
506 ;; Refresh the display of unmatched syntax tokens if enabled 512 ;; Refresh the display of unmatched syntax tokens if enabled
507 (run-hook-with-args 'semantic-unmatched-syntax-hook 513 (run-hook-with-args 'semantic-unmatched-syntax-hook
508 semantic-unmatched-syntax-cache) 514 semantic-unmatched-syntax-cache)
@@ -580,7 +586,7 @@ was marked unparseable, then do nothing, and return the cache."
580 (semantic-clear-unmatched-syntax-cache) 586 (semantic-clear-unmatched-syntax-cache)
581 (run-hook-with-args ;; Let hooks know the updated tags 587 (run-hook-with-args ;; Let hooks know the updated tags
582 'semantic-after-partial-cache-change-hook res)) 588 'semantic-after-partial-cache-change-hook res))
583 ) 589 (setq semantic--completion-cache nil))
584 590
585;;;; Parse the whole system. 591;;;; Parse the whole system.
586 ((semantic-parse-tree-needs-rebuild-p) 592 ((semantic-parse-tree-needs-rebuild-p)
@@ -819,6 +825,147 @@ a START and END part."
819 825
820;;; User interface 826;;; User interface
821 827
828(defun semantic-force-refresh ()
829 "Force a full refresh of the current buffer's tags.
830Throw away all the old tags, and recreate the tag database."
831 (interactive)
832 (semantic-clear-toplevel-cache)
833 (semantic-fetch-tags))
834
835(defvar semantic-mode-map
836 (let ((map (make-sparse-keymap))
837 (menu (make-sparse-keymap "Semantic"))
838 (navigate-menu (make-sparse-keymap "Navigate Tags"))
839 (edit-menu (make-sparse-keymap "Edit Tags")))
840
841 (define-key edit-menu [semantic-analyze-possible-completions]
842 '(menu-item "List Completions" semantic-analyze-possible-completions
843 :help "Display a list of completions for the tag at point"))
844 (define-key edit-menu [semantic-complete-analyze-inline]
845 '(menu-item "Complete Tag Inline" semantic-complete-analyze-inline
846 :help "Display inline completion for the tag at point"))
847 (define-key edit-menu [semantic-completion-separator]
848 '("--"))
849 (define-key edit-menu [senator-transpose-tags-down]
850 '(menu-item "Transpose Tags Down" senator-transpose-tags-down
851 :active (semantic-current-tag)
852 :help "Transpose the current tag and the next tag"))
853 (define-key edit-menu [senator-transpose-tags-up]
854 '(menu-item "Transpose Tags Up" senator-transpose-tags-up
855 :active (semantic-current-tag)
856 :help "Transpose the current tag and the previous tag"))
857 (define-key edit-menu [semantic-edit-separator]
858 '("--"))
859 (define-key edit-menu [senator-yank-tag]
860 '(menu-item "Yank Tag" senator-yank-tag
861 :active (not (ring-empty-p senator-tag-ring))
862 :help "Yank the head of the tag ring into the buffer"))
863 (define-key edit-menu [senator-copy-tag-to-register]
864 '(menu-item "Copy Tag To Register" senator-copy-tag-to-register
865 :active (semantic-current-tag)
866 :help "Yank the head of the tag ring into the buffer"))
867 (define-key edit-menu [senator-copy-tag]
868 '(menu-item "Copy Tag" senator-copy-tag
869 :active (semantic-current-tag)
870 :help "Copy the current tag to the tag ring"))
871 (define-key edit-menu [senator-kill-tag]
872 '(menu-item "Kill Tag" senator-kill-tag
873 :active (semantic-current-tag)
874 :help "Kill the current tag, and copy it to the tag ring"))
875
876 (define-key navigate-menu [senator-narrow-to-defun]
877 '(menu-item "Narrow to Tag" senator-narrow-to-defun
878 :active (semantic-current-tag)
879 :help "Narrow the buffer to the bounds of the current tag"))
880 (define-key navigate-menu [semantic-narrow-to-defun-separator]
881 '("--"))
882 (define-key navigate-menu [semantic-symref-symbol]
883 '(menu-item "Find Tag References..." semantic-symref-symbol
884 :help "Read a tag and list the references to it"))
885 (define-key navigate-menu [semantic-complete-jump]
886 '(menu-item "Find Tag Globally..." semantic-complete-jump
887 :help "Read a tag name and find it in the current project"))
888 (define-key navigate-menu [semantic-complete-jump-local]
889 '(menu-item "Find Tag in This Buffer..." semantic-complete-jump-local
890 :help "Read a tag name and find it in this buffer"))
891 (define-key navigate-menu [semantic-navigation-separator]
892 '("--"))
893 (define-key navigate-menu [senator-go-to-up-reference]
894 '(menu-item "Parent Tag" senator-go-to-up-reference
895 :help "Navigate up one reference by tag."))
896 (define-key navigate-menu [senator-next-tag]
897 '(menu-item "Next Tag" senator-next-tag
898 :help "Go to the next tag"))
899 (define-key navigate-menu [senator-previous-tag]
900 '(menu-item "Previous Tag" senator-previous-tag
901 :help "Go to the previous tag"))
902
903 (define-key menu [semantic-force-refresh]
904 '(menu-item "Reparse Buffer" semantic-force-refresh
905 :help "Force a full reparse of the current buffer."))
906 (define-key menu [semantic-refresh-separator]
907 '("--"))
908 (define-key menu [edit-menu]
909 (cons "Edit Tags" edit-menu))
910 (define-key menu [navigate-menu]
911 (cons "Navigate Tags" navigate-menu))
912 (define-key menu [semantic-options-separator]
913 '("--"))
914 (define-key menu [global-semantic-highlight-func-mode]
915 (menu-bar-make-mm-toggle
916 global-semantic-highlight-func-mode
917 "Highlight Current Function"
918 "Highlight the tag at point"))
919 (define-key menu [global-semantic-decoration-mode]
920 (menu-bar-make-mm-toggle
921 global-semantic-decoration-mode
922 "Decorate Tags"
923 "Decorate tags based on various attributes"))
924 (define-key menu [global-semantic-idle-completions-mode]
925 (menu-bar-make-mm-toggle
926 global-semantic-idle-completions-mode
927 "Show Tag Completions"
928 "Show tag completions when idle"))
929 (define-key menu [global-semantic-idle-summary-mode]
930 (menu-bar-make-mm-toggle
931 global-semantic-idle-summary-mode
932 "Show Tag Summaries"
933 "Show tag summaries when idle"))
934 (define-key menu [global-semanticdb-minor-mode]
935 '(menu-item "Semantic Database" global-semanticdb-minor-mode
936 :help "Store tag information in a database"
937 :button (:toggle . (semanticdb-minor-mode-p))))
938 (define-key menu [global-semantic-idle-scheduler-mode]
939 (menu-bar-make-mm-toggle
940 global-semantic-idle-scheduler-mode
941 "Reparse When Idle"
942 "Keep a buffer's parse tree up to date when idle"))
943 (define-key map [menu-bar semantic]
944 (cons "Development" menu))
945
946 ;; Key bindings:
947
948 ;; (define-key km "f" 'senator-search-set-tag-class-filter)
949 ;; (define-key km "i" 'senator-isearch-toggle-semantic-mode)
950 (define-key map "\C-c,j" 'semantic-complete-jump-local)
951 (define-key map "\C-c,J" 'semantic-complete-jump)
952 (define-key map "\C-c,g" 'semantic-symref-symbol)
953 (define-key map "\C-c,G" 'semantic-symref)
954 (define-key map "\C-c,p" 'senator-previous-tag)
955 (define-key map "\C-c,n" 'senator-next-tag)
956 (define-key map "\C-c,u" 'senator-go-to-up-reference)
957 (define-key map "\C-c, " 'semantic-complete-analyze-inline)
958 (define-key map "\C-c,\C-w" 'senator-kill-tag)
959 (define-key map "\C-c,\M-w" 'senator-copy-tag)
960 (define-key map "\C-c,\C-y" 'senator-yank-tag)
961 (define-key map "\C-c,r" 'senator-copy-tag-to-register)
962 (define-key map [?\C-c ?, up] 'senator-transpose-tags-up)
963 (define-key map [?\C-c ?, down] 'senator-transpose-tags-down)
964 (define-key map "\C-c,l" 'semantic-analyze-possible-completions)
965 ;; (define-key km "-" 'senator-fold-tag)
966 ;; (define-key km "+" 'senator-unfold-tag)
967 map))
968
822;; The `semantic-mode' command, in conjuction with the 969;; The `semantic-mode' command, in conjuction with the
823;; `semantic-default-submodes' variable, are used to collectively 970;; `semantic-default-submodes' variable, are used to collectively
824;; toggle Semantic's various auxilliary minor modes. 971;; toggle Semantic's various auxilliary minor modes.
@@ -867,11 +1014,16 @@ In Semantic mode, Emacs parses the buffers you visit for their
867semantic content. This information is used by a variety of 1014semantic content. This information is used by a variety of
868auxilliary minor modes, listed in `semantic-default-submodes'; 1015auxilliary minor modes, listed in `semantic-default-submodes';
869all the minor modes in this list are also enabled when you enable 1016all the minor modes in this list are also enabled when you enable
870Semantic mode." 1017Semantic mode.
1018
1019\\{semantic-mode-map}"
1020 :global t
871 :group 'semantic 1021 :group 'semantic
872 (if semantic-mode 1022 (if semantic-mode
873 ;; Turn on Semantic mode 1023 ;; Turn on Semantic mode
874 (progn 1024 (progn
1025 ;; Enable all the global auxilliary minor modes in
1026 ;; `semantic-submode-list'.
875 (dolist (mode semantic-submode-list) 1027 (dolist (mode semantic-submode-list)
876 (if (memq mode semantic-default-submodes) 1028 (if (memq mode semantic-default-submodes)
877 (funcall mode 1))) 1029 (funcall mode 1)))
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index ab9b887f3c5..cb573e35c1e 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -73,7 +73,8 @@ updated in the current buffer.
73 73
74For language specific hooks, make sure you define this as a local hook.") 74For language specific hooks, make sure you define this as a local hook.")
75 75
76(defvar semantic-change-hooks nil 76(defvar semantic-change-hooks
77 '(semantic-edits-change-function-handle-changes)
77 "Abnormal hook run when semantic detects a change in a buffer. 78 "Abnormal hook run when semantic detects a change in a buffer.
78Each hook function must take three arguments, identical to the 79Each hook function must take three arguments, identical to the
79common hook `after-change-functions'.") 80common hook `after-change-functions'.")
@@ -956,11 +957,7 @@ lost if not transferred into NEWTAG."
956 ;; to point at the updated state of the world. 957 ;; to point at the updated state of the world.
957 (semantic-overlay-put o 'semantic oldtag) 958 (semantic-overlay-put o 'semantic oldtag)
958 )) 959 ))
959 960
960;;; Setup incremental parser
961;;
962(add-hook 'semantic-change-hooks
963 #'semantic-edits-change-function-handle-changes)
964(add-hook 'semantic-before-toplevel-cache-flush-hook 961(add-hook 'semantic-before-toplevel-cache-flush-hook
965 #'semantic-edits-flush-changes) 962 #'semantic-edits-flush-changes)
966 963
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 52d696af4c4..86cef704069 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -69,13 +69,13 @@
69 "Timer used to schedule tasks in idle time that may take a while.") 69 "Timer used to schedule tasks in idle time that may take a while.")
70 70
71(defcustom semantic-idle-scheduler-verbose-flag nil 71(defcustom semantic-idle-scheduler-verbose-flag nil
72 "*Non-nil means that the idle scheduler should provide debug messages. 72 "Non-nil means that the idle scheduler should provide debug messages.
73Use this setting to debug idle activities." 73Use this setting to debug idle activities."
74 :group 'semantic 74 :group 'semantic
75 :type 'boolean) 75 :type 'boolean)
76 76
77(defcustom semantic-idle-scheduler-idle-time 2 77(defcustom semantic-idle-scheduler-idle-time 1
78 "*Time in seconds of idle before scheduling events. 78 "Time in seconds of idle before scheduling events.
79This time should be short enough to ensure that idle-scheduler will be 79This time should be short enough to ensure that idle-scheduler will be
80run as soon as Emacs is idle." 80run as soon as Emacs is idle."
81 :group 'semantic 81 :group 'semantic
@@ -88,7 +88,7 @@ run as soon as Emacs is idle."
88 (semantic-idle-scheduler-setup-timers)))) 88 (semantic-idle-scheduler-setup-timers))))
89 89
90(defcustom semantic-idle-scheduler-work-idle-time 60 90(defcustom semantic-idle-scheduler-work-idle-time 60
91 "*Time in seconds of idle before scheduling big work. 91 "Time in seconds of idle before scheduling big work.
92This time should be long enough that once any big work is started, it is 92This time should be long enough that once any big work is started, it is
93unlikely the user would be ready to type again right away." 93unlikely the user would be ready to type again right away."
94 :group 'semantic 94 :group 'semantic
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
new file mode 100644
index 00000000000..41735f9c6c7
--- /dev/null
+++ b/lisp/cedet/semantic/senator.el
@@ -0,0 +1,888 @@
1;;; semantic/senator.el --- SEmantic NAvigaTOR
2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4;; 2009 Free Software Foundation, Inc.
5
6;; Author: David Ponce <david@dponce.com>
7;; Maintainer: FSF
8;; Created: 10 Nov 2000
9;; Keywords: syntax
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26;;; Commentary:
27;;
28;; This file defines some user commands for navigating between
29;; Semantic tags. This is a subset of the version of senator.el in
30;; the upstream CEDET package; the rest is incorporated into other
31;; parts of Semantic or Emacs.
32
33;;; Code:
34
35(require 'ring)
36(require 'semantic)
37(require 'semantic/ctxt)
38(require 'semantic/decorate)
39(require 'semantic/format)
40
41(eval-when-compile (require 'semantic/find))
42
43;; (eval-when-compile (require 'hippie-exp))
44
45(declare-function semanticdb-fast-strip-find-results "semantic/db-find")
46(declare-function semanticdb-deep-find-tags-for-completion "semantic/db-find")
47(declare-function semantic-analyze-tag-references "semantic/analyze/refs")
48(declare-function semantic-analyze-refs-impl "semantic/analyze/refs")
49(declare-function semantic-analyze-find-tag "semantic/analyze")
50(declare-function semantic-analyze-tag-type "semantic/analyze/fcn")
51(declare-function semantic-tag-external-class "semantic/sort")
52(declare-function imenu--mouse-menu "imenu")
53
54;;; Customization
55(defgroup senator nil
56 "Semantic Navigator."
57 :group 'semantic)
58
59;;;###autoload
60(defcustom senator-step-at-tag-classes nil
61 "List of tag classes recognized by Senator's navigation commands.
62A tag class is a symbol, such as `variable', `function', or `type'.
63
64As a special exception, if the value is nil, Senator's navigation
65commands recognize all tag classes."
66 :group 'senator
67 :type '(repeat (symbol)))
68;;;###autoload
69(make-variable-buffer-local 'senator-step-at-tag-classes)
70
71;;;###autoload
72(defcustom senator-step-at-start-end-tag-classes nil
73 "List of tag classes at which Senator's navigation commands should stop.
74A tag class is a symbol, such as `variable', `function', or `type'.
75The navigation commands stop at the start and end of each tag
76class in this list, provided the tag class is recognized (see
77`senator-step-at-tag-classes').
78
79As a special exception, if the value is nil, the navigation
80commands stop at the beginning of every tag.
81
82If t, the navigation commands stop at the start and end of any
83tag, where possible."
84 :group 'senator
85 :type '(choice :tag "Identifiers"
86 (repeat :menu-tag "Symbols" (symbol))
87 (const :tag "All" t)))
88;;;###autoload
89(make-variable-buffer-local 'senator-step-at-start-end-tag-classes)
90
91(defcustom senator-highlight-found nil
92 "If non-nil, Senator commands momentarily highlight found tags."
93 :group 'senator
94 :type 'boolean)
95(make-variable-buffer-local 'senator-highlight-found)
96
97;;; Faces
98(defface senator-momentary-highlight-face
99 '((((class color) (background dark))
100 (:background "gray30"))
101 (((class color) (background light))
102 (:background "gray70")))
103 "Face used to momentarily highlight tags."
104 :group 'semantic-faces)
105
106;;; Common functions
107
108(defun senator-momentary-highlight-tag (tag)
109 "Momentarily highlight TAG.
110Does nothing if `senator-highlight-found' is nil."
111 (and senator-highlight-found
112 (semantic-momentary-highlight-tag
113 tag 'senator-momentary-highlight-face)))
114
115(defun senator-step-at-start-end-p (tag)
116 "Return non-nil if must step at start and end of TAG."
117 (and tag
118 (or (eq senator-step-at-start-end-tag-classes t)
119 (memq (semantic-tag-class tag)
120 senator-step-at-start-end-tag-classes))))
121
122(defun senator-skip-p (tag)
123 "Return non-nil if must skip TAG."
124 (and tag
125 senator-step-at-tag-classes
126 (not (memq (semantic-tag-class tag)
127 senator-step-at-tag-classes))))
128
129(defun senator-middle-of-tag-p (pos tag)
130 "Return non-nil if POS is between start and end of TAG."
131 (and (> pos (semantic-tag-start tag))
132 (< pos (semantic-tag-end tag))))
133
134(defun senator-step-at-parent (tag)
135 "Return TAG's outermost parent if must step at start/end of it.
136Return nil otherwise."
137 (if tag
138 (let (parent parents)
139 (setq parents (semantic-find-tag-by-overlay
140 (semantic-tag-start tag)))
141 (while (and parents (not parent))
142 (setq parent (car parents)
143 parents (cdr parents))
144 (if (or (eq tag parent)
145 (senator-skip-p parent)
146 (not (senator-step-at-start-end-p parent)))
147 (setq parent nil)))
148 parent)))
149
150(defun senator-previous-tag-or-parent (pos)
151 "Return the tag before POS or one of its parent where to step."
152 (let (ol tag)
153 (while (and pos (> pos (point-min)) (not tag))
154 (setq pos (semantic-overlay-previous-change pos))
155 (when pos
156 ;; Get overlays at position
157 (setq ol (semantic-overlays-at pos))
158 ;; find the overlay that belongs to semantic
159 ;; and STARTS or ENDS at the found position.
160 (while (and ol (not tag))
161 (setq tag (semantic-overlay-get (car ol) 'semantic))
162 (unless (and tag (semantic-tag-p tag)
163 (or (= (semantic-tag-start tag) pos)
164 (= (semantic-tag-end tag) pos)))
165 (setq tag nil
166 ol (cdr ol))))))
167 (or (senator-step-at-parent tag) tag)))
168
169;;; Search functions
170
171(defun senator-search-tag-name (tag)
172 "Search for TAG name in current buffer.
173Limit the search to TAG bounds.
174If found, set point to the end of the name, and return point. The
175beginning of the name is at (match-beginning 0).
176Return nil if not found, that is if TAG name doesn't come from the
177source."
178 (let ((name (semantic-tag-name tag)))
179 (setq name (if (string-match "\\`\\([^[]+\\)[[]" name)
180 (match-string 1 name)
181 name))
182 (goto-char (semantic-tag-start tag))
183 (when (re-search-forward (concat
184 ;; The tag name is expected to be
185 ;; between word delimiters, whitespaces,
186 ;; or punctuations.
187 "\\(\\<\\|\\s-+\\|\\s.\\)"
188 (regexp-quote name)
189 "\\(\\>\\|\\s-+\\|\\s.\\)")
190 (semantic-tag-end tag)
191 t)
192 (goto-char (match-beginning 0))
193 (search-forward name))))
194
195(defcustom senator-search-ignore-tag-classes
196 '(code block)
197 "List of ignored tag classes.
198Tags of those classes are excluded from search."
199 :group 'senator
200 :type '(repeat (symbol :tag "class")))
201
202(defun senator-search-default-tag-filter (tag)
203 "Default function that filters searched tags.
204Ignore tags of classes in `senator-search-ignore-tag-classes'"
205 (not (memq (semantic-tag-class tag)
206 senator-search-ignore-tag-classes)))
207
208(defvar senator-search-tag-filter-functions
209 '(senator-search-default-tag-filter)
210 "List of functions to be called to filter searched tags.
211Each function is passed a tag. If one of them returns nil, the tag is
212excluded from the search.")
213
214(defun senator-search (searcher text &optional bound noerror count)
215 "Use the SEARCHER function to search from point for TEXT in a tag name.
216SEARCHER is typically the function `search-forward', `search-backward',
217`word-search-forward', `word-search-backward', `re-search-forward', or
218`re-search-backward'. See one of the above function to see how the
219TEXT, BOUND, NOERROR, and COUNT arguments are interpreted."
220 (let* ((origin (point))
221 (count (or count 1))
222 (step (cond ((> count 0) 1)
223 ((< count 0) (setq count (- count)) -1)
224 (0)))
225 found next sstart send tag tstart tend)
226 (or (zerop step)
227 (while (and (not found)
228 (setq next (funcall searcher text bound t step)))
229 (setq sstart (match-beginning 0)
230 send (match-end 0))
231 (if (= sstart send)
232 (setq found t)
233 (and (setq tag (semantic-current-tag))
234 (run-hook-with-args-until-failure
235 'senator-search-tag-filter-functions tag)
236 (setq tend (senator-search-tag-name tag))
237 (setq tstart (match-beginning 0)
238 found (and (>= sstart tstart)
239 (<= send tend)
240 (zerop (setq count (1- count))))))
241 (goto-char next))))
242 (cond ((null found)
243 (setq next origin
244 send origin))
245 ((= next sstart)
246 (setq next send
247 send sstart))
248 (t
249 (setq next sstart)))
250 (goto-char next)
251 ;; Setup the returned value and the `match-data' or maybe fail!
252 (funcall searcher text send noerror step)))
253
254;;; Navigation commands
255
256;;;###autoload
257(defun senator-next-tag ()
258 "Navigate to the next Semantic tag.
259Return the tag or nil if at end of buffer."
260 (interactive)
261 (let ((pos (point))
262 (tag (semantic-current-tag))
263 where)
264 (if (and tag
265 (not (senator-skip-p tag))
266 (senator-step-at-start-end-p tag)
267 (or (= pos (semantic-tag-start tag))
268 (senator-middle-of-tag-p pos tag)))
269 nil
270 (if (setq tag (senator-step-at-parent tag))
271 nil
272 (setq tag (semantic-find-tag-by-overlay-next pos))
273 (while (and tag (senator-skip-p tag))
274 (setq tag (semantic-find-tag-by-overlay-next
275 (semantic-tag-start tag))))))
276 (if (not tag)
277 (progn
278 (goto-char (point-max))
279 (message "End of buffer"))
280 (cond ((and (senator-step-at-start-end-p tag)
281 (or (= pos (semantic-tag-start tag))
282 (senator-middle-of-tag-p pos tag)))
283 (setq where "end")
284 (goto-char (semantic-tag-end tag)))
285 (t
286 (setq where "start")
287 (goto-char (semantic-tag-start tag))))
288 (senator-momentary-highlight-tag tag)
289 (message "%S: %s (%s)"
290 (semantic-tag-class tag)
291 (semantic-tag-name tag)
292 where))
293 tag))
294
295;;;###autoload
296(defun senator-previous-tag ()
297 "Navigate to the previous Semantic tag.
298Return the tag or nil if at beginning of buffer."
299 (interactive)
300 (let ((pos (point))
301 (tag (semantic-current-tag))
302 where)
303 (if (and tag
304 (not (senator-skip-p tag))
305 (senator-step-at-start-end-p tag)
306 (or (= pos (semantic-tag-end tag))
307 (senator-middle-of-tag-p pos tag)))
308 nil
309 (if (setq tag (senator-step-at-parent tag))
310 nil
311 (setq tag (senator-previous-tag-or-parent pos))
312 (while (and tag (senator-skip-p tag))
313 (setq tag (senator-previous-tag-or-parent
314 (semantic-tag-start tag))))))
315 (if (not tag)
316 (progn
317 (goto-char (point-min))
318 (message "Beginning of buffer"))
319 (cond ((or (not (senator-step-at-start-end-p tag))
320 (= pos (semantic-tag-end tag))
321 (senator-middle-of-tag-p pos tag))
322 (setq where "start")
323 (goto-char (semantic-tag-start tag)))
324 (t
325 (setq where "end")
326 (goto-char (semantic-tag-end tag))))
327 (senator-momentary-highlight-tag tag)
328 (message "%S: %s (%s)"
329 (semantic-tag-class tag)
330 (semantic-tag-name tag)
331 where))
332 tag))
333
334;;; Search commands
335
336(defun senator-search-forward (string &optional bound noerror count)
337 "Search in tag names forward from point for STRING.
338Set point to the end of the occurrence found, and return point.
339See also the function `search-forward' for details on the BOUND,
340NOERROR and COUNT arguments."
341 (interactive "sSemantic search: ")
342 (senator-search 'search-forward string bound noerror count))
343
344(defun senator-re-search-forward (regexp &optional bound noerror count)
345 "Search in tag names forward from point for regular expression REGEXP.
346Set point to the end of the occurrence found, and return point.
347See also the function `re-search-forward' for details on the BOUND,
348NOERROR and COUNT arguments."
349 (interactive "sSemantic regexp search: ")
350 (senator-search 're-search-forward regexp bound noerror count))
351
352(defun senator-word-search-forward (word &optional bound noerror count)
353 "Search in tag names forward from point for WORD.
354Set point to the end of the occurrence found, and return point.
355See also the function `word-search-forward' for details on the BOUND,
356NOERROR and COUNT arguments."
357 (interactive "sSemantic word search: ")
358 (senator-search 'word-search-forward word bound noerror count))
359
360(defun senator-search-backward (string &optional bound noerror count)
361 "Search in tag names backward from point for STRING.
362Set point to the beginning of the occurrence found, and return point.
363See also the function `search-backward' for details on the BOUND,
364NOERROR and COUNT arguments."
365 (interactive "sSemantic backward search: ")
366 (senator-search 'search-backward string bound noerror count))
367
368(defun senator-re-search-backward (regexp &optional bound noerror count)
369 "Search in tag names backward from point for regular expression REGEXP.
370Set point to the beginning of the occurrence found, and return point.
371See also the function `re-search-backward' for details on the BOUND,
372NOERROR and COUNT arguments."
373 (interactive "sSemantic backward regexp search: ")
374 (senator-search 're-search-backward regexp bound noerror count))
375
376(defun senator-word-search-backward (word &optional bound noerror count)
377 "Search in tag names backward from point for WORD.
378Set point to the beginning of the occurrence found, and return point.
379See also the function `word-search-backward' for details on the BOUND,
380NOERROR and COUNT arguments."
381 (interactive "sSemantic backward word search: ")
382 (senator-search 'word-search-backward word bound noerror count))
383
384;;; Other useful search commands (minor mode menu)
385
386(defvar senator-last-search-type nil
387 "Type of last non-incremental search command called.")
388
389(defun senator-nonincremental-repeat-search-forward ()
390 "Search forward for the previous search string or regexp."
391 (interactive)
392 (cond
393 ((and (eq senator-last-search-type 'string)
394 search-ring)
395 (senator-search-forward (car search-ring)))
396 ((and (eq senator-last-search-type 'regexp)
397 regexp-search-ring)
398 (senator-re-search-forward (car regexp-search-ring)))
399 (t
400 (error "No previous search"))))
401
402(defun senator-nonincremental-repeat-search-backward ()
403 "Search backward for the previous search string or regexp."
404 (interactive)
405 (cond
406 ((and (eq senator-last-search-type 'string)
407 search-ring)
408 (senator-search-backward (car search-ring)))
409 ((and (eq senator-last-search-type 'regexp)
410 regexp-search-ring)
411 (senator-re-search-backward (car regexp-search-ring)))
412 (t
413 (error "No previous search"))))
414
415(defun senator-nonincremental-search-forward (string)
416 "Search for STRING nonincrementally."
417 (interactive "sSemantic search for string: ")
418 (setq senator-last-search-type 'string)
419 (if (equal string "")
420 (senator-search-forward (car search-ring))
421 (isearch-update-ring string nil)
422 (senator-search-forward string)))
423
424(defun senator-nonincremental-search-backward (string)
425 "Search backward for STRING nonincrementally."
426 (interactive "sSemantic search for string: ")
427 (setq senator-last-search-type 'string)
428 (if (equal string "")
429 (senator-search-backward (car search-ring))
430 (isearch-update-ring string nil)
431 (senator-search-backward string)))
432
433(defun senator-nonincremental-re-search-forward (string)
434 "Search for the regular expression STRING nonincrementally."
435 (interactive "sSemantic search for regexp: ")
436 (setq senator-last-search-type 'regexp)
437 (if (equal string "")
438 (senator-re-search-forward (car regexp-search-ring))
439 (isearch-update-ring string t)
440 (senator-re-search-forward string)))
441
442(defun senator-nonincremental-re-search-backward (string)
443 "Search backward for the regular expression STRING nonincrementally."
444 (interactive "sSemantic search for regexp: ")
445 (setq senator-last-search-type 'regexp)
446 (if (equal string "")
447 (senator-re-search-backward (car regexp-search-ring))
448 (isearch-update-ring string t)
449 (senator-re-search-backward string)))
450
451(defvar senator--search-filter nil)
452
453(defun senator-search-set-tag-class-filter (&optional classes)
454 "In current buffer, limit search scope to tag CLASSES.
455CLASSES is a list of tag class symbols or nil. If nil only global
456filters in `senator-search-tag-filter-functions' remain active."
457 (interactive "sClasses: ")
458 (setq classes
459 (cond
460 ((null classes)
461 nil)
462 ((symbolp classes)
463 (list classes))
464 ((stringp classes)
465 (mapcar 'read (split-string classes)))
466 (t
467 (signal 'wrong-type-argument (list classes)))
468 ))
469 ;; Clear previous filter.
470 (remove-hook 'senator-search-tag-filter-functions
471 senator--search-filter t)
472 (kill-local-variable 'senator--search-filter)
473 (if classes
474 (let ((tag (make-symbol "tag"))
475 (names (mapconcat 'symbol-name classes "', `")))
476 (set (make-local-variable 'senator--search-filter)
477 `(lambda (,tag)
478 (memq (semantic-tag-class ,tag) ',classes)))
479 (add-hook 'senator-search-tag-filter-functions
480 senator--search-filter nil t)
481 (message "Limit search to `%s' tags" names))
482 (message "Default search filter restored")))
483
484;;; Folding
485;;
486;; Use new folding state. It might be wise to extend the idea
487;; of folding for hiding all but this, or show all children, etc.
488
489(defun senator-fold-tag (&optional tag)
490 "Fold the current TAG."
491 (interactive)
492 (semantic-set-tag-folded (or tag (semantic-current-tag)) t))
493
494(defun senator-unfold-tag (&optional tag)
495 "Fold the current TAG."
496 (interactive)
497 (semantic-set-tag-folded (or tag (semantic-current-tag)) nil))
498
499(defun senator-fold-tag-toggle (&optional tag)
500 "Fold the current TAG."
501 (interactive)
502 (let ((tag (or tag (semantic-current-tag))))
503 (if (semantic-tag-folded-p tag)
504 (senator-unfold-tag tag)
505 (senator-fold-tag tag))))
506
507;; @TODO - move this to some analyzer / refs tool
508(define-overloadable-function semantic-up-reference (tag)
509 "Return a tag that is referred to by TAG.
510A \"reference\" could be any interesting feature of TAG.
511In C++, a function may have a 'parent' which is non-local.
512If that parent which is only a reference in the function tag
513is found, we can jump to it.
514Some tags such as includes have other reference features.")
515
516;;;###autoload
517(defun senator-go-to-up-reference (&optional tag)
518 "Move up one reference from the current TAG.
519A \"reference\" could be any interesting feature of TAG.
520In C++, a function may have a 'parent' which is non-local.
521If that parent which is only a reference in the function tag
522is found, we can jump to it.
523Some tags such as includes have other reference features."
524 (interactive)
525 (let ((result (semantic-up-reference (or tag (semantic-current-tag)))))
526 (if (not result)
527 (error "No up reference found")
528 (push-mark)
529 (cond
530 ;; A tag
531 ((semantic-tag-p result)
532 (semantic-go-to-tag result)
533 (switch-to-buffer (current-buffer))
534 (semantic-momentary-highlight-tag result))
535 ;; Buffers
536 ((bufferp result)
537 (switch-to-buffer result)
538 (pulse-momentary-highlight-one-line (point)))
539 ;; Files
540 ((and (stringp result) (file-exists-p result))
541 (find-file result)
542 (pulse-momentary-highlight-one-line (point)))
543 (t
544 (error "Unknown result type from `semantic-up-reference'"))))))
545
546(defun semantic-up-reference-default (tag)
547 "Return a tag that is referredto by TAG.
548Makes C/C++ language like assumptions."
549 (cond ((semantic-tag-faux-p tag)
550 ;; Faux tags should have a real tag in some other location.
551 (require 'semantic/sort)
552 (let ((options (semantic-tag-external-class tag)))
553 ;; I should do something a little better than
554 ;; this. Oy!
555 (car options)
556 ))
557
558 ;; Include always point to another file.
559 ((eq (semantic-tag-class tag) 'include)
560 (let ((file (semantic-dependency-tag-file tag)))
561 (cond
562 ((or (not file) (not (file-exists-p file)))
563 (error "Could not location include %s"
564 (semantic-tag-name tag)))
565 ((get-file-buffer file)
566 (get-file-buffer file))
567 ((stringp file)
568 file)
569 )))
570
571 ;; Is there a parent of the function to jump to?
572 ((and (semantic-tag-of-class-p tag 'function)
573 (semantic-tag-function-parent tag))
574 (let* ((scope (semantic-calculate-scope (point))))
575 ;; @todo - it would be cool to ask the user which one if
576 ;; more than one.
577 (car (oref scope parents))
578 ))
579
580 ;; Is there a non-prototype version of the tag to jump to?
581 ((semantic-tag-get-attribute tag :prototype-flag)
582 (require 'semantic/analyze/refs)
583 (let* ((sar (semantic-analyze-tag-references tag)))
584 (car (semantic-analyze-refs-impl sar t)))
585 )
586
587 ;; If this is a datatype, and we have superclasses
588 ((and (semantic-tag-of-class-p tag 'type)
589 (semantic-tag-type-superclasses tag))
590 (require 'semantic/analyze)
591 (let ((scope (semantic-calculate-scope (point)))
592 (parents (semantic-tag-type-superclasses tag)))
593 (semantic-analyze-find-tag (car parents) 'type scope)))
594
595 ;; Get the data type, and try to find that.
596 ((semantic-tag-type tag)
597 (require 'semantic/analyze)
598 (let ((scope (semantic-calculate-scope (point))))
599 (semantic-analyze-tag-type tag scope))
600 )
601 (t nil)))
602
603(defvar senator-isearch-semantic-mode nil
604 "Non-nil if isearch does semantic search.
605This is a buffer local variable.")
606(make-variable-buffer-local 'senator-isearch-semantic-mode)
607
608(defun senator-beginning-of-defun (&optional arg)
609 "Move backward to the beginning of a defun.
610Use semantic tags to navigate.
611ARG is the number of tags to navigate (not yet implemented)."
612 (semantic-fetch-tags)
613 (let* ((senator-highlight-found nil)
614 ;; Step at beginning of next tag with class specified in
615 ;; `senator-step-at-tag-classes'.
616 (senator-step-at-start-end-tag-classes t)
617 (tag (senator-previous-tag)))
618 (when tag
619 (if (= (point) (semantic-tag-end tag))
620 (goto-char (semantic-tag-start tag)))
621 (beginning-of-line))))
622
623(defun senator-end-of-defun (&optional arg)
624 "Move forward to next end of defun.
625Use semantic tags to navigate.
626ARG is the number of tags to navigate (not yet implemented)."
627 (semantic-fetch-tags)
628 (let* ((senator-highlight-found nil)
629 ;; Step at end of next tag with class specified in
630 ;; `senator-step-at-tag-classes'.
631 (senator-step-at-start-end-tag-classes t)
632 (tag (senator-next-tag)))
633 (when tag
634 (if (= (point) (semantic-tag-start tag))
635 (goto-char (semantic-tag-end tag)))
636 (skip-chars-forward " \t")
637 (if (looking-at "\\s<\\|\n")
638 (forward-line 1)))))
639
640(defun senator-narrow-to-defun ()
641 "Make text outside current defun invisible.
642The defun visible is the one that contains point or follows point.
643Use semantic tags to navigate."
644 (interactive)
645 (semantic-fetch-tags)
646 (save-excursion
647 (widen)
648 (senator-end-of-defun)
649 (let ((end (point)))
650 (senator-beginning-of-defun)
651 (narrow-to-region (point) end))))
652
653(defun senator-mark-defun ()
654 "Put mark at end of this defun, point at beginning.
655The defun marked is the one that contains point or follows point.
656Use semantic tags to navigate."
657 (interactive)
658 (let ((origin (point))
659 (end (progn (senator-end-of-defun) (point)))
660 (start (progn (senator-beginning-of-defun) (point))))
661 (goto-char origin)
662 (push-mark (point))
663 (goto-char end) ;; end-of-defun
664 (push-mark (point) nil t)
665 (goto-char start) ;; beginning-of-defun
666 (re-search-backward "^\n" (- (point) 1) t)))
667
668;;; Tag Cut & Paste
669
670;; To copy a tag, means to put a tag definition into the tag
671;; ring. To kill a tag, put the tag into the tag ring AND put
672;; the body of the tag into the kill-ring.
673;;
674;; To retrieve a killed tag's text, use C-y (yank), but to retrieve
675;; the tag as a reference of some sort, use senator-yank-tag.
676
677(defvar senator-tag-ring (make-ring 20)
678 "Ring of tags for use with cut and paste.")
679
680;;;###autoload
681(defun senator-copy-tag ()
682 "Take the current tag, and place it in the tag ring."
683 (interactive)
684 (semantic-fetch-tags)
685 (let ((ft (semantic-obtain-foreign-tag)))
686 (when ft
687 (ring-insert senator-tag-ring ft)
688 (kill-ring-save (semantic-tag-start ft) (semantic-tag-end ft))
689 (when (interactive-p)
690 (message "Use C-y to yank text. Use `senator-yank-tag' for prototype insert."))
691 )
692 ft))
693
694;;;###autoload
695(defun senator-kill-tag ()
696 "Take the current tag, place it in the tag ring, and kill it.
697Killing the tag removes the text for that tag, and places it into
698the kill ring. Retrieve that text with \\[yank]."
699 (interactive)
700 (let ((ct (senator-copy-tag))) ;; this handles the reparse for us.
701 (kill-region (semantic-tag-start ct)
702 (semantic-tag-end ct))
703 (when (interactive-p)
704 (message "Use C-y to yank text. Use `senator-yank-tag' for prototype insert."))
705 ))
706
707;;;###autoload
708(defun senator-yank-tag ()
709 "Yank a tag from the tag ring.
710The form the tag takes is differnet depending on where it is being
711yanked to."
712 (interactive)
713 (or (ring-empty-p senator-tag-ring)
714 (let ((ft (ring-ref senator-tag-ring 0)))
715 (semantic-foreign-tag-check ft)
716 (semantic-insert-foreign-tag ft)
717 (when (interactive-p)
718 (message "Use C-y to recover the yank the text of %s."
719 (semantic-tag-name ft)))
720 )))
721
722;;;###autoload
723(defun senator-copy-tag-to-register (register &optional kill-flag)
724 "Copy the current tag into REGISTER.
725Optional argument KILL-FLAG will delete the text of the tag to the
726kill ring."
727 (interactive "cTag to register: \nP")
728 (semantic-fetch-tags)
729 (let ((ft (semantic-obtain-foreign-tag)))
730 (when ft
731 (set-register register ft)
732 (if kill-flag
733 (kill-region (semantic-tag-start ft)
734 (semantic-tag-end ft))))))
735
736;;;###autoload
737(defun senator-transpose-tags-up ()
738 "Transpose the current tag, and the preceeding tag."
739 (interactive)
740 (semantic-fetch-tags)
741 (let* ((current-tag (semantic-current-tag))
742 (prev-tag (save-excursion
743 (goto-char (semantic-tag-start current-tag))
744 (semantic-find-tag-by-overlay-prev)))
745 (ct-parent (semantic-find-tag-parent-by-overlay current-tag))
746 (pt-parent (semantic-find-tag-parent-by-overlay prev-tag)))
747 (if (not (eq ct-parent pt-parent))
748 (error "Cannot transpose tags"))
749 (let ((txt (buffer-substring (semantic-tag-start current-tag)
750 (semantic-tag-end current-tag)))
751 (line (count-lines (semantic-tag-start current-tag)
752 (point)))
753 (insert-point nil)
754 )
755 (delete-region (semantic-tag-start current-tag)
756 (semantic-tag-end current-tag))
757 (delete-blank-lines)
758 (goto-char (semantic-tag-start prev-tag))
759 (setq insert-point (point))
760 (insert txt)
761 (if (/= (current-column) 0)
762 (insert "\n"))
763 (insert "\n")
764 (goto-char insert-point)
765 (forward-line line)
766 )))
767
768;;;###autoload
769(defun senator-transpose-tags-down ()
770 "Transpose the current tag, and the following tag."
771 (interactive)
772 (semantic-fetch-tags)
773 (let* ((current-tag (semantic-current-tag))
774 (next-tag (save-excursion
775 (goto-char (semantic-tag-end current-tag))
776 (semantic-find-tag-by-overlay-next)))
777 (end-pt (point-marker))
778 )
779 (goto-char (semantic-tag-start next-tag))
780 (forward-char 1)
781 (senator-transpose-tags-up)
782 ;; I know that the above fcn deletes the next tag, so our pt marker
783 ;; will be stable.
784 (goto-char end-pt)))
785
786;;; Using semantic search in isearch mode
787
788(defun senator-lazy-highlight-update ()
789 "Force lazy highlight update."
790 (lazy-highlight-cleanup t)
791 (set 'isearch-lazy-highlight-last-string nil)
792 (setq isearch-adjusted t)
793 (isearch-update))
794
795;; Recent versions of GNU Emacs allow to override the isearch search
796;; function for special needs, and avoid to advice the built-in search
797;; function :-)
798(defun senator-isearch-search-fun ()
799 "Return the function to use for the search.
800Use a senator search function when semantic isearch mode is enabled."
801 (intern
802 (concat (if senator-isearch-semantic-mode
803 "senator-"
804 "")
805 (cond (isearch-word "word-")
806 (isearch-regexp "re-")
807 (t ""))
808 "search-"
809 (if isearch-forward
810 "forward"
811 "backward"))))
812
813(defun senator-isearch-toggle-semantic-mode ()
814 "Toggle semantic searching on or off in isearch mode."
815 (interactive)
816 (setq senator-isearch-semantic-mode
817 (not senator-isearch-semantic-mode))
818 (if isearch-mode
819 ;; force lazy highlight update
820 (senator-lazy-highlight-update)
821 (message "Isearch semantic mode %s"
822 (if senator-isearch-semantic-mode
823 "enabled"
824 "disabled"))))
825
826(defvar senator-old-isearch-search-fun nil
827 "Hold previous value of `isearch-search-fun-function'.")
828
829(defun senator-isearch-mode-hook ()
830 "Isearch mode hook to setup semantic searching."
831 (if (and isearch-mode senator-isearch-semantic-mode)
832 (progn
833 ;; When `senator-isearch-semantic-mode' is on save the
834 ;; previous `isearch-search-fun-function' and install the
835 ;; senator one.
836 (when (and (local-variable-p 'isearch-search-fun-function)
837 (not (local-variable-p 'senator-old-isearch-search-fun)))
838 (set (make-local-variable 'senator-old-isearch-search-fun)
839 isearch-search-fun-function))
840 (set (make-local-variable 'isearch-search-fun-function)
841 'senator-isearch-search-fun))
842 ;; When `senator-isearch-semantic-mode' is off restore the
843 ;; previous `isearch-search-fun-function'.
844 (when (eq isearch-search-fun-function 'senator-isearch-search-fun)
845 (if (local-variable-p 'senator-old-isearch-search-fun)
846 (progn
847 (set (make-local-variable 'isearch-search-fun-function)
848 senator-old-isearch-search-fun)
849 (kill-local-variable 'senator-old-isearch-search-fun))
850 (kill-local-variable 'isearch-search-fun-function)))))
851
852;; (add-hook 'isearch-mode-hook 'senator-isearch-mode-hook)
853;; (add-hook 'isearch-mode-end-hook 'senator-isearch-mode-hook)
854
855;; ;; Keyboard shortcut to toggle semantic search in isearch mode.
856;; (define-key isearch-mode-map
857;; [(control ?,)]
858;; 'senator-isearch-toggle-semantic-mode)
859
860;; (defadvice insert-register (around senator activate)
861;; "Insert contents of register REGISTER as a tag.
862;; If senator is not active, use the original mechanism."
863;; (let ((val (get-register (ad-get-arg 0))))
864;; (if (and senator-minor-mode (interactive-p)
865;; (semantic-foreign-tag-p val))
866;; (semantic-insert-foreign-tag val)
867;; ad-do-it)))
868
869;; (defadvice jump-to-register (around senator activate)
870;; "Insert contents of register REGISTER as a tag.
871;; If senator is not active, use the original mechanism."
872;; (let ((val (get-register (ad-get-arg 0))))
873;; (if (and senator-minor-mode (interactive-p)
874;; (semantic-foreign-tag-p val))
875;; (progn
876;; (switch-to-buffer (semantic-tag-buffer val))
877;; (goto-char (semantic-tag-start val)))
878;; ad-do-it)))
879
880(provide 'semantic/senator)
881
882;; Local variables:
883;; generated-autoload-file: "loaddefs.el"
884;; generated-autoload-feature: semantic/loaddefs
885;; generated-autoload-load-name: "semantic/senator"
886;; End:
887
888;;; semantic/senator.el ends here
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 2e67a60cd05..7889656bd7e 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -447,13 +447,6 @@ NOTFIRST indicates that this was not the first call in the recursive use."
447 447
448;; Symbol completion 448;; Symbol completion
449 449
450(defvar semantic--completion-cache nil
451 "Internal variable used by `senator-complete-symbol'.")
452
453(defsubst semantic-symbol-start (pos)
454 "Return the start of the symbol at buffer position POS."
455 (car (nth 2 (semantic-ctxt-current-symbol-and-bounds pos))))
456
457(defun semantic-find-tag-for-completion (prefix) 450(defun semantic-find-tag-for-completion (prefix)
458 "Find all tags with name starting with PREFIX. 451 "Find all tags with name starting with PREFIX.
459This uses `semanticdb' when available." 452This uses `semanticdb' when available."