diff options
| author | Chong Yidong | 2009-09-27 03:36:58 +0000 |
|---|---|---|
| committer | Chong Yidong | 2009-09-27 03:36:58 +0000 |
| commit | 8bf997efee7b3bc523a4c2bad3a1b228b14e40dd (patch) | |
| tree | 3bde994dcf96888d6fbb17cdb89e9c17a11f1eb5 | |
| parent | eb1ac101af57ea1c780cf2142af9f49be7b45b58 (diff) | |
| download | emacs-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/ChangeLog | 24 | ||||
| -rw-r--r-- | lisp/cedet/ede.el | 7 | ||||
| -rw-r--r-- | lisp/cedet/semantic.el | 158 | ||||
| -rw-r--r-- | lisp/cedet/semantic/edit.el | 9 | ||||
| -rw-r--r-- | lisp/cedet/semantic/idle.el | 8 | ||||
| -rw-r--r-- | lisp/cedet/semantic/senator.el | 888 | ||||
| -rw-r--r-- | lisp/cedet/semantic/util.el | 7 |
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 @@ | |||
| 1 | 2009-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 | |||
| 1 | 2009-09-26 Chong Yidong <cyd@stupidchicken.com> | 25 | 2009-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. | ||
| 830 | Throw 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 | |||
| 867 | semantic content. This information is used by a variety of | 1014 | semantic content. This information is used by a variety of |
| 868 | auxilliary minor modes, listed in `semantic-default-submodes'; | 1015 | auxilliary minor modes, listed in `semantic-default-submodes'; |
| 869 | all the minor modes in this list are also enabled when you enable | 1016 | all the minor modes in this list are also enabled when you enable |
| 870 | Semantic mode." | 1017 | Semantic 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 | ||
| 74 | For language specific hooks, make sure you define this as a local hook.") | 74 | For 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. |
| 78 | Each hook function must take three arguments, identical to the | 79 | Each hook function must take three arguments, identical to the |
| 79 | common hook `after-change-functions'.") | 80 | common 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. |
| 73 | Use this setting to debug idle activities." | 73 | Use 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. |
| 79 | This time should be short enough to ensure that idle-scheduler will be | 79 | This time should be short enough to ensure that idle-scheduler will be |
| 80 | run as soon as Emacs is idle." | 80 | run 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. |
| 92 | This time should be long enough that once any big work is started, it is | 92 | This time should be long enough that once any big work is started, it is |
| 93 | unlikely the user would be ready to type again right away." | 93 | unlikely 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. | ||
| 62 | A tag class is a symbol, such as `variable', `function', or `type'. | ||
| 63 | |||
| 64 | As a special exception, if the value is nil, Senator's navigation | ||
| 65 | commands 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. | ||
| 74 | A tag class is a symbol, such as `variable', `function', or `type'. | ||
| 75 | The navigation commands stop at the start and end of each tag | ||
| 76 | class in this list, provided the tag class is recognized (see | ||
| 77 | `senator-step-at-tag-classes'). | ||
| 78 | |||
| 79 | As a special exception, if the value is nil, the navigation | ||
| 80 | commands stop at the beginning of every tag. | ||
| 81 | |||
| 82 | If t, the navigation commands stop at the start and end of any | ||
| 83 | tag, 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. | ||
| 110 | Does 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. | ||
| 136 | Return 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. | ||
| 173 | Limit the search to TAG bounds. | ||
| 174 | If found, set point to the end of the name, and return point. The | ||
| 175 | beginning of the name is at (match-beginning 0). | ||
| 176 | Return nil if not found, that is if TAG name doesn't come from the | ||
| 177 | source." | ||
| 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. | ||
| 198 | Tags 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. | ||
| 204 | Ignore 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. | ||
| 211 | Each function is passed a tag. If one of them returns nil, the tag is | ||
| 212 | excluded 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. | ||
| 216 | SEARCHER 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 | ||
| 219 | TEXT, 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. | ||
| 259 | Return 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. | ||
| 298 | Return 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. | ||
| 338 | Set point to the end of the occurrence found, and return point. | ||
| 339 | See also the function `search-forward' for details on the BOUND, | ||
| 340 | NOERROR 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. | ||
| 346 | Set point to the end of the occurrence found, and return point. | ||
| 347 | See also the function `re-search-forward' for details on the BOUND, | ||
| 348 | NOERROR 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. | ||
| 354 | Set point to the end of the occurrence found, and return point. | ||
| 355 | See also the function `word-search-forward' for details on the BOUND, | ||
| 356 | NOERROR 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. | ||
| 362 | Set point to the beginning of the occurrence found, and return point. | ||
| 363 | See also the function `search-backward' for details on the BOUND, | ||
| 364 | NOERROR 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. | ||
| 370 | Set point to the beginning of the occurrence found, and return point. | ||
| 371 | See also the function `re-search-backward' for details on the BOUND, | ||
| 372 | NOERROR 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. | ||
| 378 | Set point to the beginning of the occurrence found, and return point. | ||
| 379 | See also the function `word-search-backward' for details on the BOUND, | ||
| 380 | NOERROR 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. | ||
| 455 | CLASSES is a list of tag class symbols or nil. If nil only global | ||
| 456 | filters 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. | ||
| 510 | A \"reference\" could be any interesting feature of TAG. | ||
| 511 | In C++, a function may have a 'parent' which is non-local. | ||
| 512 | If that parent which is only a reference in the function tag | ||
| 513 | is found, we can jump to it. | ||
| 514 | Some 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. | ||
| 519 | A \"reference\" could be any interesting feature of TAG. | ||
| 520 | In C++, a function may have a 'parent' which is non-local. | ||
| 521 | If that parent which is only a reference in the function tag | ||
| 522 | is found, we can jump to it. | ||
| 523 | Some 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. | ||
| 548 | Makes 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. | ||
| 605 | This 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. | ||
| 610 | Use semantic tags to navigate. | ||
| 611 | ARG 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. | ||
| 625 | Use semantic tags to navigate. | ||
| 626 | ARG 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. | ||
| 642 | The defun visible is the one that contains point or follows point. | ||
| 643 | Use 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. | ||
| 655 | The defun marked is the one that contains point or follows point. | ||
| 656 | Use 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. | ||
| 697 | Killing the tag removes the text for that tag, and places it into | ||
| 698 | the 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. | ||
| 710 | The form the tag takes is differnet depending on where it is being | ||
| 711 | yanked 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. | ||
| 725 | Optional argument KILL-FLAG will delete the text of the tag to the | ||
| 726 | kill 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. | ||
| 800 | Use 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. |
| 459 | This uses `semanticdb' when available." | 452 | This uses `semanticdb' when available." |