mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-11 16:08:13 +00:00
* 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.
This commit is contained in:
Chong Yidong
parent
eb1ac101af
commit
8bf997efee
@ -1,3 +1,27 @@
|
||||
2009-09-27 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* 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.
|
||||
|
||||
2009-09-26 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* cedet/srecode/mode.el (srecode-menu-bar): Use
|
||||
|
||||
@ -706,9 +706,10 @@ Argument MENU-DEF is the definition of the current menu."
|
||||
(easy-menu-create-menu
|
||||
"Customize Project"
|
||||
(let* ((obj (ede-current-project))
|
||||
(targ (when (slot-boundp obj 'targets)
|
||||
(oref obj targets))))
|
||||
targ)
|
||||
(when obj
|
||||
(setq targ (when (slot-boundp obj 'targets)
|
||||
(oref obj targets)))
|
||||
;; Make custom menus for everything here.
|
||||
(append (list
|
||||
(cons (concat "Project " (ede-name obj))
|
||||
@ -759,7 +760,7 @@ If optional argument CURRENT is non-nil, return sub-menu code."
|
||||
;;; Mode Declarations
|
||||
;;
|
||||
(eval-and-compile
|
||||
(autoload 'ede-dired-minor-mode "ede-dired" "EDE commands for dired" t))
|
||||
(autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t))
|
||||
|
||||
(defun ede-apply-target-options ()
|
||||
"Apply options to the current buffer for the active project/target."
|
||||
|
||||
@ -204,6 +204,10 @@ during a flush when the cache is given a new value of nil.")
|
||||
(defvar semantic-parser-name "LL"
|
||||
"Optional name of the parser used to parse input stream.")
|
||||
(make-variable-buffer-local 'semantic-parser-name)
|
||||
|
||||
(defvar semantic--completion-cache nil
|
||||
"Internal variable used by `semantic-complete-symbol'.")
|
||||
(make-variable-buffer-local 'semantic--completion-cache)
|
||||
|
||||
;;; Parse tree state management API
|
||||
;;
|
||||
@ -487,7 +491,8 @@ is requested."
|
||||
|
||||
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
|
||||
semantic--buffer-cache)
|
||||
)
|
||||
|
||||
(setq semantic--completion-cache nil))
|
||||
|
||||
(defvar semantic-bovinate-nonterminal-check-obarray)
|
||||
|
||||
@ -503,6 +508,7 @@ is requested."
|
||||
(add-hook 'after-change-functions 'semantic-change-function nil t)
|
||||
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
|
||||
semantic--buffer-cache)
|
||||
(setq semantic--completion-cache nil)
|
||||
;; Refresh the display of unmatched syntax tokens if enabled
|
||||
(run-hook-with-args 'semantic-unmatched-syntax-hook
|
||||
semantic-unmatched-syntax-cache)
|
||||
@ -580,7 +586,7 @@ was marked unparseable, then do nothing, and return the cache."
|
||||
(semantic-clear-unmatched-syntax-cache)
|
||||
(run-hook-with-args ;; Let hooks know the updated tags
|
||||
'semantic-after-partial-cache-change-hook res))
|
||||
)
|
||||
(setq semantic--completion-cache nil))
|
||||
|
||||
;;;; Parse the whole system.
|
||||
((semantic-parse-tree-needs-rebuild-p)
|
||||
@ -819,6 +825,147 @@ a START and END part."
|
||||
|
||||
;;; User interface
|
||||
|
||||
(defun semantic-force-refresh ()
|
||||
"Force a full refresh of the current buffer's tags.
|
||||
Throw away all the old tags, and recreate the tag database."
|
||||
(interactive)
|
||||
(semantic-clear-toplevel-cache)
|
||||
(semantic-fetch-tags))
|
||||
|
||||
(defvar semantic-mode-map
|
||||
(let ((map (make-sparse-keymap))
|
||||
(menu (make-sparse-keymap "Semantic"))
|
||||
(navigate-menu (make-sparse-keymap "Navigate Tags"))
|
||||
(edit-menu (make-sparse-keymap "Edit Tags")))
|
||||
|
||||
(define-key edit-menu [semantic-analyze-possible-completions]
|
||||
'(menu-item "List Completions" semantic-analyze-possible-completions
|
||||
:help "Display a list of completions for the tag at point"))
|
||||
(define-key edit-menu [semantic-complete-analyze-inline]
|
||||
'(menu-item "Complete Tag Inline" semantic-complete-analyze-inline
|
||||
:help "Display inline completion for the tag at point"))
|
||||
(define-key edit-menu [semantic-completion-separator]
|
||||
'("--"))
|
||||
(define-key edit-menu [senator-transpose-tags-down]
|
||||
'(menu-item "Transpose Tags Down" senator-transpose-tags-down
|
||||
:active (semantic-current-tag)
|
||||
:help "Transpose the current tag and the next tag"))
|
||||
(define-key edit-menu [senator-transpose-tags-up]
|
||||
'(menu-item "Transpose Tags Up" senator-transpose-tags-up
|
||||
:active (semantic-current-tag)
|
||||
:help "Transpose the current tag and the previous tag"))
|
||||
(define-key edit-menu [semantic-edit-separator]
|
||||
'("--"))
|
||||
(define-key edit-menu [senator-yank-tag]
|
||||
'(menu-item "Yank Tag" senator-yank-tag
|
||||
:active (not (ring-empty-p senator-tag-ring))
|
||||
:help "Yank the head of the tag ring into the buffer"))
|
||||
(define-key edit-menu [senator-copy-tag-to-register]
|
||||
'(menu-item "Copy Tag To Register" senator-copy-tag-to-register
|
||||
:active (semantic-current-tag)
|
||||
:help "Yank the head of the tag ring into the buffer"))
|
||||
(define-key edit-menu [senator-copy-tag]
|
||||
'(menu-item "Copy Tag" senator-copy-tag
|
||||
:active (semantic-current-tag)
|
||||
:help "Copy the current tag to the tag ring"))
|
||||
(define-key edit-menu [senator-kill-tag]
|
||||
'(menu-item "Kill Tag" senator-kill-tag
|
||||
:active (semantic-current-tag)
|
||||
:help "Kill the current tag, and copy it to the tag ring"))
|
||||
|
||||
(define-key navigate-menu [senator-narrow-to-defun]
|
||||
'(menu-item "Narrow to Tag" senator-narrow-to-defun
|
||||
:active (semantic-current-tag)
|
||||
:help "Narrow the buffer to the bounds of the current tag"))
|
||||
(define-key navigate-menu [semantic-narrow-to-defun-separator]
|
||||
'("--"))
|
||||
(define-key navigate-menu [semantic-symref-symbol]
|
||||
'(menu-item "Find Tag References..." semantic-symref-symbol
|
||||
:help "Read a tag and list the references to it"))
|
||||
(define-key navigate-menu [semantic-complete-jump]
|
||||
'(menu-item "Find Tag Globally..." semantic-complete-jump
|
||||
:help "Read a tag name and find it in the current project"))
|
||||
(define-key navigate-menu [semantic-complete-jump-local]
|
||||
'(menu-item "Find Tag in This Buffer..." semantic-complete-jump-local
|
||||
:help "Read a tag name and find it in this buffer"))
|
||||
(define-key navigate-menu [semantic-navigation-separator]
|
||||
'("--"))
|
||||
(define-key navigate-menu [senator-go-to-up-reference]
|
||||
'(menu-item "Parent Tag" senator-go-to-up-reference
|
||||
:help "Navigate up one reference by tag."))
|
||||
(define-key navigate-menu [senator-next-tag]
|
||||
'(menu-item "Next Tag" senator-next-tag
|
||||
:help "Go to the next tag"))
|
||||
(define-key navigate-menu [senator-previous-tag]
|
||||
'(menu-item "Previous Tag" senator-previous-tag
|
||||
:help "Go to the previous tag"))
|
||||
|
||||
(define-key menu [semantic-force-refresh]
|
||||
'(menu-item "Reparse Buffer" semantic-force-refresh
|
||||
:help "Force a full reparse of the current buffer."))
|
||||
(define-key menu [semantic-refresh-separator]
|
||||
'("--"))
|
||||
(define-key menu [edit-menu]
|
||||
(cons "Edit Tags" edit-menu))
|
||||
(define-key menu [navigate-menu]
|
||||
(cons "Navigate Tags" navigate-menu))
|
||||
(define-key menu [semantic-options-separator]
|
||||
'("--"))
|
||||
(define-key menu [global-semantic-highlight-func-mode]
|
||||
(menu-bar-make-mm-toggle
|
||||
global-semantic-highlight-func-mode
|
||||
"Highlight Current Function"
|
||||
"Highlight the tag at point"))
|
||||
(define-key menu [global-semantic-decoration-mode]
|
||||
(menu-bar-make-mm-toggle
|
||||
global-semantic-decoration-mode
|
||||
"Decorate Tags"
|
||||
"Decorate tags based on various attributes"))
|
||||
(define-key menu [global-semantic-idle-completions-mode]
|
||||
(menu-bar-make-mm-toggle
|
||||
global-semantic-idle-completions-mode
|
||||
"Show Tag Completions"
|
||||
"Show tag completions when idle"))
|
||||
(define-key menu [global-semantic-idle-summary-mode]
|
||||
(menu-bar-make-mm-toggle
|
||||
global-semantic-idle-summary-mode
|
||||
"Show Tag Summaries"
|
||||
"Show tag summaries when idle"))
|
||||
(define-key menu [global-semanticdb-minor-mode]
|
||||
'(menu-item "Semantic Database" global-semanticdb-minor-mode
|
||||
:help "Store tag information in a database"
|
||||
:button (:toggle . (semanticdb-minor-mode-p))))
|
||||
(define-key menu [global-semantic-idle-scheduler-mode]
|
||||
(menu-bar-make-mm-toggle
|
||||
global-semantic-idle-scheduler-mode
|
||||
"Reparse When Idle"
|
||||
"Keep a buffer's parse tree up to date when idle"))
|
||||
(define-key map [menu-bar semantic]
|
||||
(cons "Development" menu))
|
||||
|
||||
;; Key bindings:
|
||||
|
||||
;; (define-key km "f" 'senator-search-set-tag-class-filter)
|
||||
;; (define-key km "i" 'senator-isearch-toggle-semantic-mode)
|
||||
(define-key map "\C-c,j" 'semantic-complete-jump-local)
|
||||
(define-key map "\C-c,J" 'semantic-complete-jump)
|
||||
(define-key map "\C-c,g" 'semantic-symref-symbol)
|
||||
(define-key map "\C-c,G" 'semantic-symref)
|
||||
(define-key map "\C-c,p" 'senator-previous-tag)
|
||||
(define-key map "\C-c,n" 'senator-next-tag)
|
||||
(define-key map "\C-c,u" 'senator-go-to-up-reference)
|
||||
(define-key map "\C-c, " 'semantic-complete-analyze-inline)
|
||||
(define-key map "\C-c,\C-w" 'senator-kill-tag)
|
||||
(define-key map "\C-c,\M-w" 'senator-copy-tag)
|
||||
(define-key map "\C-c,\C-y" 'senator-yank-tag)
|
||||
(define-key map "\C-c,r" 'senator-copy-tag-to-register)
|
||||
(define-key map [?\C-c ?, up] 'senator-transpose-tags-up)
|
||||
(define-key map [?\C-c ?, down] 'senator-transpose-tags-down)
|
||||
(define-key map "\C-c,l" 'semantic-analyze-possible-completions)
|
||||
;; (define-key km "-" 'senator-fold-tag)
|
||||
;; (define-key km "+" 'senator-unfold-tag)
|
||||
map))
|
||||
|
||||
;; The `semantic-mode' command, in conjuction with the
|
||||
;; `semantic-default-submodes' variable, are used to collectively
|
||||
;; toggle Semantic's various auxilliary minor modes.
|
||||
@ -867,11 +1014,16 @@ In Semantic mode, Emacs parses the buffers you visit for their
|
||||
semantic content. This information is used by a variety of
|
||||
auxilliary minor modes, listed in `semantic-default-submodes';
|
||||
all the minor modes in this list are also enabled when you enable
|
||||
Semantic mode."
|
||||
Semantic mode.
|
||||
|
||||
\\{semantic-mode-map}"
|
||||
:global t
|
||||
:group 'semantic
|
||||
(if semantic-mode
|
||||
;; Turn on Semantic mode
|
||||
(progn
|
||||
;; Enable all the global auxilliary minor modes in
|
||||
;; `semantic-submode-list'.
|
||||
(dolist (mode semantic-submode-list)
|
||||
(if (memq mode semantic-default-submodes)
|
||||
(funcall mode 1)))
|
||||
|
||||
@ -73,7 +73,8 @@ updated in the current buffer.
|
||||
|
||||
For language specific hooks, make sure you define this as a local hook.")
|
||||
|
||||
(defvar semantic-change-hooks nil
|
||||
(defvar semantic-change-hooks
|
||||
'(semantic-edits-change-function-handle-changes)
|
||||
"Abnormal hook run when semantic detects a change in a buffer.
|
||||
Each hook function must take three arguments, identical to the
|
||||
common hook `after-change-functions'.")
|
||||
@ -956,11 +957,7 @@ lost if not transferred into NEWTAG."
|
||||
;; to point at the updated state of the world.
|
||||
(semantic-overlay-put o 'semantic oldtag)
|
||||
))
|
||||
|
||||
;;; Setup incremental parser
|
||||
;;
|
||||
(add-hook 'semantic-change-hooks
|
||||
#'semantic-edits-change-function-handle-changes)
|
||||
|
||||
(add-hook 'semantic-before-toplevel-cache-flush-hook
|
||||
#'semantic-edits-flush-changes)
|
||||
|
||||
|
||||
@ -69,13 +69,13 @@
|
||||
"Timer used to schedule tasks in idle time that may take a while.")
|
||||
|
||||
(defcustom semantic-idle-scheduler-verbose-flag nil
|
||||
"*Non-nil means that the idle scheduler should provide debug messages.
|
||||
"Non-nil means that the idle scheduler should provide debug messages.
|
||||
Use this setting to debug idle activities."
|
||||
:group 'semantic
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom semantic-idle-scheduler-idle-time 2
|
||||
"*Time in seconds of idle before scheduling events.
|
||||
(defcustom semantic-idle-scheduler-idle-time 1
|
||||
"Time in seconds of idle before scheduling events.
|
||||
This time should be short enough to ensure that idle-scheduler will be
|
||||
run as soon as Emacs is idle."
|
||||
:group 'semantic
|
||||
@ -88,7 +88,7 @@ run as soon as Emacs is idle."
|
||||
(semantic-idle-scheduler-setup-timers))))
|
||||
|
||||
(defcustom semantic-idle-scheduler-work-idle-time 60
|
||||
"*Time in seconds of idle before scheduling big work.
|
||||
"Time in seconds of idle before scheduling big work.
|
||||
This time should be long enough that once any big work is started, it is
|
||||
unlikely the user would be ready to type again right away."
|
||||
:group 'semantic
|
||||
|
||||
888
lisp/cedet/semantic/senator.el
Normal file
888
lisp/cedet/semantic/senator.el
Normal file
@ -0,0 +1,888 @@
|
||||
;;; semantic/senator.el --- SEmantic NAvigaTOR
|
||||
|
||||
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
||||
;; 2009 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: David Ponce <david@dponce.com>
|
||||
;; Maintainer: FSF
|
||||
;; Created: 10 Nov 2000
|
||||
;; Keywords: syntax
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file defines some user commands for navigating between
|
||||
;; Semantic tags. This is a subset of the version of senator.el in
|
||||
;; the upstream CEDET package; the rest is incorporated into other
|
||||
;; parts of Semantic or Emacs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ring)
|
||||
(require 'semantic)
|
||||
(require 'semantic/ctxt)
|
||||
(require 'semantic/decorate)
|
||||
(require 'semantic/format)
|
||||
|
||||
(eval-when-compile (require 'semantic/find))
|
||||
|
||||
;; (eval-when-compile (require 'hippie-exp))
|
||||
|
||||
(declare-function semanticdb-fast-strip-find-results "semantic/db-find")
|
||||
(declare-function semanticdb-deep-find-tags-for-completion "semantic/db-find")
|
||||
(declare-function semantic-analyze-tag-references "semantic/analyze/refs")
|
||||
(declare-function semantic-analyze-refs-impl "semantic/analyze/refs")
|
||||
(declare-function semantic-analyze-find-tag "semantic/analyze")
|
||||
(declare-function semantic-analyze-tag-type "semantic/analyze/fcn")
|
||||
(declare-function semantic-tag-external-class "semantic/sort")
|
||||
(declare-function imenu--mouse-menu "imenu")
|
||||
|
||||
;;; Customization
|
||||
(defgroup senator nil
|
||||
"Semantic Navigator."
|
||||
:group 'semantic)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom senator-step-at-tag-classes nil
|
||||
"List of tag classes recognized by Senator's navigation commands.
|
||||
A tag class is a symbol, such as `variable', `function', or `type'.
|
||||
|
||||
As a special exception, if the value is nil, Senator's navigation
|
||||
commands recognize all tag classes."
|
||||
:group 'senator
|
||||
:type '(repeat (symbol)))
|
||||
;;;###autoload
|
||||
(make-variable-buffer-local 'senator-step-at-tag-classes)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom senator-step-at-start-end-tag-classes nil
|
||||
"List of tag classes at which Senator's navigation commands should stop.
|
||||
A tag class is a symbol, such as `variable', `function', or `type'.
|
||||
The navigation commands stop at the start and end of each tag
|
||||
class in this list, provided the tag class is recognized (see
|
||||
`senator-step-at-tag-classes').
|
||||
|
||||
As a special exception, if the value is nil, the navigation
|
||||
commands stop at the beginning of every tag.
|
||||
|
||||
If t, the navigation commands stop at the start and end of any
|
||||
tag, where possible."
|
||||
:group 'senator
|
||||
:type '(choice :tag "Identifiers"
|
||||
(repeat :menu-tag "Symbols" (symbol))
|
||||
(const :tag "All" t)))
|
||||
;;;###autoload
|
||||
(make-variable-buffer-local 'senator-step-at-start-end-tag-classes)
|
||||
|
||||
(defcustom senator-highlight-found nil
|
||||
"If non-nil, Senator commands momentarily highlight found tags."
|
||||
:group 'senator
|
||||
:type 'boolean)
|
||||
(make-variable-buffer-local 'senator-highlight-found)
|
||||
|
||||
;;; Faces
|
||||
(defface senator-momentary-highlight-face
|
||||
'((((class color) (background dark))
|
||||
(:background "gray30"))
|
||||
(((class color) (background light))
|
||||
(:background "gray70")))
|
||||
"Face used to momentarily highlight tags."
|
||||
:group 'semantic-faces)
|
||||
|
||||
;;; Common functions
|
||||
|
||||
(defun senator-momentary-highlight-tag (tag)
|
||||
"Momentarily highlight TAG.
|
||||
Does nothing if `senator-highlight-found' is nil."
|
||||
(and senator-highlight-found
|
||||
(semantic-momentary-highlight-tag
|
||||
tag 'senator-momentary-highlight-face)))
|
||||
|
||||
(defun senator-step-at-start-end-p (tag)
|
||||
"Return non-nil if must step at start and end of TAG."
|
||||
(and tag
|
||||
(or (eq senator-step-at-start-end-tag-classes t)
|
||||
(memq (semantic-tag-class tag)
|
||||
senator-step-at-start-end-tag-classes))))
|
||||
|
||||
(defun senator-skip-p (tag)
|
||||
"Return non-nil if must skip TAG."
|
||||
(and tag
|
||||
senator-step-at-tag-classes
|
||||
(not (memq (semantic-tag-class tag)
|
||||
senator-step-at-tag-classes))))
|
||||
|
||||
(defun senator-middle-of-tag-p (pos tag)
|
||||
"Return non-nil if POS is between start and end of TAG."
|
||||
(and (> pos (semantic-tag-start tag))
|
||||
(< pos (semantic-tag-end tag))))
|
||||
|
||||
(defun senator-step-at-parent (tag)
|
||||
"Return TAG's outermost parent if must step at start/end of it.
|
||||
Return nil otherwise."
|
||||
(if tag
|
||||
(let (parent parents)
|
||||
(setq parents (semantic-find-tag-by-overlay
|
||||
(semantic-tag-start tag)))
|
||||
(while (and parents (not parent))
|
||||
(setq parent (car parents)
|
||||
parents (cdr parents))
|
||||
(if (or (eq tag parent)
|
||||
(senator-skip-p parent)
|
||||
(not (senator-step-at-start-end-p parent)))
|
||||
(setq parent nil)))
|
||||
parent)))
|
||||
|
||||
(defun senator-previous-tag-or-parent (pos)
|
||||
"Return the tag before POS or one of its parent where to step."
|
||||
(let (ol tag)
|
||||
(while (and pos (> pos (point-min)) (not tag))
|
||||
(setq pos (semantic-overlay-previous-change pos))
|
||||
(when pos
|
||||
;; Get overlays at position
|
||||
(setq ol (semantic-overlays-at pos))
|
||||
;; find the overlay that belongs to semantic
|
||||
;; and STARTS or ENDS at the found position.
|
||||
(while (and ol (not tag))
|
||||
(setq tag (semantic-overlay-get (car ol) 'semantic))
|
||||
(unless (and tag (semantic-tag-p tag)
|
||||
(or (= (semantic-tag-start tag) pos)
|
||||
(= (semantic-tag-end tag) pos)))
|
||||
(setq tag nil
|
||||
ol (cdr ol))))))
|
||||
(or (senator-step-at-parent tag) tag)))
|
||||
|
||||
;;; Search functions
|
||||
|
||||
(defun senator-search-tag-name (tag)
|
||||
"Search for TAG name in current buffer.
|
||||
Limit the search to TAG bounds.
|
||||
If found, set point to the end of the name, and return point. The
|
||||
beginning of the name is at (match-beginning 0).
|
||||
Return nil if not found, that is if TAG name doesn't come from the
|
||||
source."
|
||||
(let ((name (semantic-tag-name tag)))
|
||||
(setq name (if (string-match "\\`\\([^[]+\\)[[]" name)
|
||||
(match-string 1 name)
|
||||
name))
|
||||
(goto-char (semantic-tag-start tag))
|
||||
(when (re-search-forward (concat
|
||||
;; The tag name is expected to be
|
||||
;; between word delimiters, whitespaces,
|
||||
;; or punctuations.
|
||||
"\\(\\<\\|\\s-+\\|\\s.\\)"
|
||||
(regexp-quote name)
|
||||
"\\(\\>\\|\\s-+\\|\\s.\\)")
|
||||
(semantic-tag-end tag)
|
||||
t)
|
||||
(goto-char (match-beginning 0))
|
||||
(search-forward name))))
|
||||
|
||||
(defcustom senator-search-ignore-tag-classes
|
||||
'(code block)
|
||||
"List of ignored tag classes.
|
||||
Tags of those classes are excluded from search."
|
||||
:group 'senator
|
||||
:type '(repeat (symbol :tag "class")))
|
||||
|
||||
(defun senator-search-default-tag-filter (tag)
|
||||
"Default function that filters searched tags.
|
||||
Ignore tags of classes in `senator-search-ignore-tag-classes'"
|
||||
(not (memq (semantic-tag-class tag)
|
||||
senator-search-ignore-tag-classes)))
|
||||
|
||||
(defvar senator-search-tag-filter-functions
|
||||
'(senator-search-default-tag-filter)
|
||||
"List of functions to be called to filter searched tags.
|
||||
Each function is passed a tag. If one of them returns nil, the tag is
|
||||
excluded from the search.")
|
||||
|
||||
(defun senator-search (searcher text &optional bound noerror count)
|
||||
"Use the SEARCHER function to search from point for TEXT in a tag name.
|
||||
SEARCHER is typically the function `search-forward', `search-backward',
|
||||
`word-search-forward', `word-search-backward', `re-search-forward', or
|
||||
`re-search-backward'. See one of the above function to see how the
|
||||
TEXT, BOUND, NOERROR, and COUNT arguments are interpreted."
|
||||
(let* ((origin (point))
|
||||
(count (or count 1))
|
||||
(step (cond ((> count 0) 1)
|
||||
((< count 0) (setq count (- count)) -1)
|
||||
(0)))
|
||||
found next sstart send tag tstart tend)
|
||||
(or (zerop step)
|
||||
(while (and (not found)
|
||||
(setq next (funcall searcher text bound t step)))
|
||||
(setq sstart (match-beginning 0)
|
||||
send (match-end 0))
|
||||
(if (= sstart send)
|
||||
(setq found t)
|
||||
(and (setq tag (semantic-current-tag))
|
||||
(run-hook-with-args-until-failure
|
||||
'senator-search-tag-filter-functions tag)
|
||||
(setq tend (senator-search-tag-name tag))
|
||||
(setq tstart (match-beginning 0)
|
||||
found (and (>= sstart tstart)
|
||||
(<= send tend)
|
||||
(zerop (setq count (1- count))))))
|
||||
(goto-char next))))
|
||||
(cond ((null found)
|
||||
(setq next origin
|
||||
send origin))
|
||||
((= next sstart)
|
||||
(setq next send
|
||||
send sstart))
|
||||
(t
|
||||
(setq next sstart)))
|
||||
(goto-char next)
|
||||
;; Setup the returned value and the `match-data' or maybe fail!
|
||||
(funcall searcher text send noerror step)))
|
||||
|
||||
;;; Navigation commands
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-next-tag ()
|
||||
"Navigate to the next Semantic tag.
|
||||
Return the tag or nil if at end of buffer."
|
||||
(interactive)
|
||||
(let ((pos (point))
|
||||
(tag (semantic-current-tag))
|
||||
where)
|
||||
(if (and tag
|
||||
(not (senator-skip-p tag))
|
||||
(senator-step-at-start-end-p tag)
|
||||
(or (= pos (semantic-tag-start tag))
|
||||
(senator-middle-of-tag-p pos tag)))
|
||||
nil
|
||||
(if (setq tag (senator-step-at-parent tag))
|
||||
nil
|
||||
(setq tag (semantic-find-tag-by-overlay-next pos))
|
||||
(while (and tag (senator-skip-p tag))
|
||||
(setq tag (semantic-find-tag-by-overlay-next
|
||||
(semantic-tag-start tag))))))
|
||||
(if (not tag)
|
||||
(progn
|
||||
(goto-char (point-max))
|
||||
(message "End of buffer"))
|
||||
(cond ((and (senator-step-at-start-end-p tag)
|
||||
(or (= pos (semantic-tag-start tag))
|
||||
(senator-middle-of-tag-p pos tag)))
|
||||
(setq where "end")
|
||||
(goto-char (semantic-tag-end tag)))
|
||||
(t
|
||||
(setq where "start")
|
||||
(goto-char (semantic-tag-start tag))))
|
||||
(senator-momentary-highlight-tag tag)
|
||||
(message "%S: %s (%s)"
|
||||
(semantic-tag-class tag)
|
||||
(semantic-tag-name tag)
|
||||
where))
|
||||
tag))
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-previous-tag ()
|
||||
"Navigate to the previous Semantic tag.
|
||||
Return the tag or nil if at beginning of buffer."
|
||||
(interactive)
|
||||
(let ((pos (point))
|
||||
(tag (semantic-current-tag))
|
||||
where)
|
||||
(if (and tag
|
||||
(not (senator-skip-p tag))
|
||||
(senator-step-at-start-end-p tag)
|
||||
(or (= pos (semantic-tag-end tag))
|
||||
(senator-middle-of-tag-p pos tag)))
|
||||
nil
|
||||
(if (setq tag (senator-step-at-parent tag))
|
||||
nil
|
||||
(setq tag (senator-previous-tag-or-parent pos))
|
||||
(while (and tag (senator-skip-p tag))
|
||||
(setq tag (senator-previous-tag-or-parent
|
||||
(semantic-tag-start tag))))))
|
||||
(if (not tag)
|
||||
(progn
|
||||
(goto-char (point-min))
|
||||
(message "Beginning of buffer"))
|
||||
(cond ((or (not (senator-step-at-start-end-p tag))
|
||||
(= pos (semantic-tag-end tag))
|
||||
(senator-middle-of-tag-p pos tag))
|
||||
(setq where "start")
|
||||
(goto-char (semantic-tag-start tag)))
|
||||
(t
|
||||
(setq where "end")
|
||||
(goto-char (semantic-tag-end tag))))
|
||||
(senator-momentary-highlight-tag tag)
|
||||
(message "%S: %s (%s)"
|
||||
(semantic-tag-class tag)
|
||||
(semantic-tag-name tag)
|
||||
where))
|
||||
tag))
|
||||
|
||||
;;; Search commands
|
||||
|
||||
(defun senator-search-forward (string &optional bound noerror count)
|
||||
"Search in tag names forward from point for STRING.
|
||||
Set point to the end of the occurrence found, and return point.
|
||||
See also the function `search-forward' for details on the BOUND,
|
||||
NOERROR and COUNT arguments."
|
||||
(interactive "sSemantic search: ")
|
||||
(senator-search 'search-forward string bound noerror count))
|
||||
|
||||
(defun senator-re-search-forward (regexp &optional bound noerror count)
|
||||
"Search in tag names forward from point for regular expression REGEXP.
|
||||
Set point to the end of the occurrence found, and return point.
|
||||
See also the function `re-search-forward' for details on the BOUND,
|
||||
NOERROR and COUNT arguments."
|
||||
(interactive "sSemantic regexp search: ")
|
||||
(senator-search 're-search-forward regexp bound noerror count))
|
||||
|
||||
(defun senator-word-search-forward (word &optional bound noerror count)
|
||||
"Search in tag names forward from point for WORD.
|
||||
Set point to the end of the occurrence found, and return point.
|
||||
See also the function `word-search-forward' for details on the BOUND,
|
||||
NOERROR and COUNT arguments."
|
||||
(interactive "sSemantic word search: ")
|
||||
(senator-search 'word-search-forward word bound noerror count))
|
||||
|
||||
(defun senator-search-backward (string &optional bound noerror count)
|
||||
"Search in tag names backward from point for STRING.
|
||||
Set point to the beginning of the occurrence found, and return point.
|
||||
See also the function `search-backward' for details on the BOUND,
|
||||
NOERROR and COUNT arguments."
|
||||
(interactive "sSemantic backward search: ")
|
||||
(senator-search 'search-backward string bound noerror count))
|
||||
|
||||
(defun senator-re-search-backward (regexp &optional bound noerror count)
|
||||
"Search in tag names backward from point for regular expression REGEXP.
|
||||
Set point to the beginning of the occurrence found, and return point.
|
||||
See also the function `re-search-backward' for details on the BOUND,
|
||||
NOERROR and COUNT arguments."
|
||||
(interactive "sSemantic backward regexp search: ")
|
||||
(senator-search 're-search-backward regexp bound noerror count))
|
||||
|
||||
(defun senator-word-search-backward (word &optional bound noerror count)
|
||||
"Search in tag names backward from point for WORD.
|
||||
Set point to the beginning of the occurrence found, and return point.
|
||||
See also the function `word-search-backward' for details on the BOUND,
|
||||
NOERROR and COUNT arguments."
|
||||
(interactive "sSemantic backward word search: ")
|
||||
(senator-search 'word-search-backward word bound noerror count))
|
||||
|
||||
;;; Other useful search commands (minor mode menu)
|
||||
|
||||
(defvar senator-last-search-type nil
|
||||
"Type of last non-incremental search command called.")
|
||||
|
||||
(defun senator-nonincremental-repeat-search-forward ()
|
||||
"Search forward for the previous search string or regexp."
|
||||
(interactive)
|
||||
(cond
|
||||
((and (eq senator-last-search-type 'string)
|
||||
search-ring)
|
||||
(senator-search-forward (car search-ring)))
|
||||
((and (eq senator-last-search-type 'regexp)
|
||||
regexp-search-ring)
|
||||
(senator-re-search-forward (car regexp-search-ring)))
|
||||
(t
|
||||
(error "No previous search"))))
|
||||
|
||||
(defun senator-nonincremental-repeat-search-backward ()
|
||||
"Search backward for the previous search string or regexp."
|
||||
(interactive)
|
||||
(cond
|
||||
((and (eq senator-last-search-type 'string)
|
||||
search-ring)
|
||||
(senator-search-backward (car search-ring)))
|
||||
((and (eq senator-last-search-type 'regexp)
|
||||
regexp-search-ring)
|
||||
(senator-re-search-backward (car regexp-search-ring)))
|
||||
(t
|
||||
(error "No previous search"))))
|
||||
|
||||
(defun senator-nonincremental-search-forward (string)
|
||||
"Search for STRING nonincrementally."
|
||||
(interactive "sSemantic search for string: ")
|
||||
(setq senator-last-search-type 'string)
|
||||
(if (equal string "")
|
||||
(senator-search-forward (car search-ring))
|
||||
(isearch-update-ring string nil)
|
||||
(senator-search-forward string)))
|
||||
|
||||
(defun senator-nonincremental-search-backward (string)
|
||||
"Search backward for STRING nonincrementally."
|
||||
(interactive "sSemantic search for string: ")
|
||||
(setq senator-last-search-type 'string)
|
||||
(if (equal string "")
|
||||
(senator-search-backward (car search-ring))
|
||||
(isearch-update-ring string nil)
|
||||
(senator-search-backward string)))
|
||||
|
||||
(defun senator-nonincremental-re-search-forward (string)
|
||||
"Search for the regular expression STRING nonincrementally."
|
||||
(interactive "sSemantic search for regexp: ")
|
||||
(setq senator-last-search-type 'regexp)
|
||||
(if (equal string "")
|
||||
(senator-re-search-forward (car regexp-search-ring))
|
||||
(isearch-update-ring string t)
|
||||
(senator-re-search-forward string)))
|
||||
|
||||
(defun senator-nonincremental-re-search-backward (string)
|
||||
"Search backward for the regular expression STRING nonincrementally."
|
||||
(interactive "sSemantic search for regexp: ")
|
||||
(setq senator-last-search-type 'regexp)
|
||||
(if (equal string "")
|
||||
(senator-re-search-backward (car regexp-search-ring))
|
||||
(isearch-update-ring string t)
|
||||
(senator-re-search-backward string)))
|
||||
|
||||
(defvar senator--search-filter nil)
|
||||
|
||||
(defun senator-search-set-tag-class-filter (&optional classes)
|
||||
"In current buffer, limit search scope to tag CLASSES.
|
||||
CLASSES is a list of tag class symbols or nil. If nil only global
|
||||
filters in `senator-search-tag-filter-functions' remain active."
|
||||
(interactive "sClasses: ")
|
||||
(setq classes
|
||||
(cond
|
||||
((null classes)
|
||||
nil)
|
||||
((symbolp classes)
|
||||
(list classes))
|
||||
((stringp classes)
|
||||
(mapcar 'read (split-string classes)))
|
||||
(t
|
||||
(signal 'wrong-type-argument (list classes)))
|
||||
))
|
||||
;; Clear previous filter.
|
||||
(remove-hook 'senator-search-tag-filter-functions
|
||||
senator--search-filter t)
|
||||
(kill-local-variable 'senator--search-filter)
|
||||
(if classes
|
||||
(let ((tag (make-symbol "tag"))
|
||||
(names (mapconcat 'symbol-name classes "', `")))
|
||||
(set (make-local-variable 'senator--search-filter)
|
||||
`(lambda (,tag)
|
||||
(memq (semantic-tag-class ,tag) ',classes)))
|
||||
(add-hook 'senator-search-tag-filter-functions
|
||||
senator--search-filter nil t)
|
||||
(message "Limit search to `%s' tags" names))
|
||||
(message "Default search filter restored")))
|
||||
|
||||
;;; Folding
|
||||
;;
|
||||
;; Use new folding state. It might be wise to extend the idea
|
||||
;; of folding for hiding all but this, or show all children, etc.
|
||||
|
||||
(defun senator-fold-tag (&optional tag)
|
||||
"Fold the current TAG."
|
||||
(interactive)
|
||||
(semantic-set-tag-folded (or tag (semantic-current-tag)) t))
|
||||
|
||||
(defun senator-unfold-tag (&optional tag)
|
||||
"Fold the current TAG."
|
||||
(interactive)
|
||||
(semantic-set-tag-folded (or tag (semantic-current-tag)) nil))
|
||||
|
||||
(defun senator-fold-tag-toggle (&optional tag)
|
||||
"Fold the current TAG."
|
||||
(interactive)
|
||||
(let ((tag (or tag (semantic-current-tag))))
|
||||
(if (semantic-tag-folded-p tag)
|
||||
(senator-unfold-tag tag)
|
||||
(senator-fold-tag tag))))
|
||||
|
||||
;; @TODO - move this to some analyzer / refs tool
|
||||
(define-overloadable-function semantic-up-reference (tag)
|
||||
"Return a tag that is referred to by TAG.
|
||||
A \"reference\" could be any interesting feature of TAG.
|
||||
In C++, a function may have a 'parent' which is non-local.
|
||||
If that parent which is only a reference in the function tag
|
||||
is found, we can jump to it.
|
||||
Some tags such as includes have other reference features.")
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-go-to-up-reference (&optional tag)
|
||||
"Move up one reference from the current TAG.
|
||||
A \"reference\" could be any interesting feature of TAG.
|
||||
In C++, a function may have a 'parent' which is non-local.
|
||||
If that parent which is only a reference in the function tag
|
||||
is found, we can jump to it.
|
||||
Some tags such as includes have other reference features."
|
||||
(interactive)
|
||||
(let ((result (semantic-up-reference (or tag (semantic-current-tag)))))
|
||||
(if (not result)
|
||||
(error "No up reference found")
|
||||
(push-mark)
|
||||
(cond
|
||||
;; A tag
|
||||
((semantic-tag-p result)
|
||||
(semantic-go-to-tag result)
|
||||
(switch-to-buffer (current-buffer))
|
||||
(semantic-momentary-highlight-tag result))
|
||||
;; Buffers
|
||||
((bufferp result)
|
||||
(switch-to-buffer result)
|
||||
(pulse-momentary-highlight-one-line (point)))
|
||||
;; Files
|
||||
((and (stringp result) (file-exists-p result))
|
||||
(find-file result)
|
||||
(pulse-momentary-highlight-one-line (point)))
|
||||
(t
|
||||
(error "Unknown result type from `semantic-up-reference'"))))))
|
||||
|
||||
(defun semantic-up-reference-default (tag)
|
||||
"Return a tag that is referredto by TAG.
|
||||
Makes C/C++ language like assumptions."
|
||||
(cond ((semantic-tag-faux-p tag)
|
||||
;; Faux tags should have a real tag in some other location.
|
||||
(require 'semantic/sort)
|
||||
(let ((options (semantic-tag-external-class tag)))
|
||||
;; I should do something a little better than
|
||||
;; this. Oy!
|
||||
(car options)
|
||||
))
|
||||
|
||||
;; Include always point to another file.
|
||||
((eq (semantic-tag-class tag) 'include)
|
||||
(let ((file (semantic-dependency-tag-file tag)))
|
||||
(cond
|
||||
((or (not file) (not (file-exists-p file)))
|
||||
(error "Could not location include %s"
|
||||
(semantic-tag-name tag)))
|
||||
((get-file-buffer file)
|
||||
(get-file-buffer file))
|
||||
((stringp file)
|
||||
file)
|
||||
)))
|
||||
|
||||
;; Is there a parent of the function to jump to?
|
||||
((and (semantic-tag-of-class-p tag 'function)
|
||||
(semantic-tag-function-parent tag))
|
||||
(let* ((scope (semantic-calculate-scope (point))))
|
||||
;; @todo - it would be cool to ask the user which one if
|
||||
;; more than one.
|
||||
(car (oref scope parents))
|
||||
))
|
||||
|
||||
;; Is there a non-prototype version of the tag to jump to?
|
||||
((semantic-tag-get-attribute tag :prototype-flag)
|
||||
(require 'semantic/analyze/refs)
|
||||
(let* ((sar (semantic-analyze-tag-references tag)))
|
||||
(car (semantic-analyze-refs-impl sar t)))
|
||||
)
|
||||
|
||||
;; If this is a datatype, and we have superclasses
|
||||
((and (semantic-tag-of-class-p tag 'type)
|
||||
(semantic-tag-type-superclasses tag))
|
||||
(require 'semantic/analyze)
|
||||
(let ((scope (semantic-calculate-scope (point)))
|
||||
(parents (semantic-tag-type-superclasses tag)))
|
||||
(semantic-analyze-find-tag (car parents) 'type scope)))
|
||||
|
||||
;; Get the data type, and try to find that.
|
||||
((semantic-tag-type tag)
|
||||
(require 'semantic/analyze)
|
||||
(let ((scope (semantic-calculate-scope (point))))
|
||||
(semantic-analyze-tag-type tag scope))
|
||||
)
|
||||
(t nil)))
|
||||
|
||||
(defvar senator-isearch-semantic-mode nil
|
||||
"Non-nil if isearch does semantic search.
|
||||
This is a buffer local variable.")
|
||||
(make-variable-buffer-local 'senator-isearch-semantic-mode)
|
||||
|
||||
(defun senator-beginning-of-defun (&optional arg)
|
||||
"Move backward to the beginning of a defun.
|
||||
Use semantic tags to navigate.
|
||||
ARG is the number of tags to navigate (not yet implemented)."
|
||||
(semantic-fetch-tags)
|
||||
(let* ((senator-highlight-found nil)
|
||||
;; Step at beginning of next tag with class specified in
|
||||
;; `senator-step-at-tag-classes'.
|
||||
(senator-step-at-start-end-tag-classes t)
|
||||
(tag (senator-previous-tag)))
|
||||
(when tag
|
||||
(if (= (point) (semantic-tag-end tag))
|
||||
(goto-char (semantic-tag-start tag)))
|
||||
(beginning-of-line))))
|
||||
|
||||
(defun senator-end-of-defun (&optional arg)
|
||||
"Move forward to next end of defun.
|
||||
Use semantic tags to navigate.
|
||||
ARG is the number of tags to navigate (not yet implemented)."
|
||||
(semantic-fetch-tags)
|
||||
(let* ((senator-highlight-found nil)
|
||||
;; Step at end of next tag with class specified in
|
||||
;; `senator-step-at-tag-classes'.
|
||||
(senator-step-at-start-end-tag-classes t)
|
||||
(tag (senator-next-tag)))
|
||||
(when tag
|
||||
(if (= (point) (semantic-tag-start tag))
|
||||
(goto-char (semantic-tag-end tag)))
|
||||
(skip-chars-forward " \t")
|
||||
(if (looking-at "\\s<\\|\n")
|
||||
(forward-line 1)))))
|
||||
|
||||
(defun senator-narrow-to-defun ()
|
||||
"Make text outside current defun invisible.
|
||||
The defun visible is the one that contains point or follows point.
|
||||
Use semantic tags to navigate."
|
||||
(interactive)
|
||||
(semantic-fetch-tags)
|
||||
(save-excursion
|
||||
(widen)
|
||||
(senator-end-of-defun)
|
||||
(let ((end (point)))
|
||||
(senator-beginning-of-defun)
|
||||
(narrow-to-region (point) end))))
|
||||
|
||||
(defun senator-mark-defun ()
|
||||
"Put mark at end of this defun, point at beginning.
|
||||
The defun marked is the one that contains point or follows point.
|
||||
Use semantic tags to navigate."
|
||||
(interactive)
|
||||
(let ((origin (point))
|
||||
(end (progn (senator-end-of-defun) (point)))
|
||||
(start (progn (senator-beginning-of-defun) (point))))
|
||||
(goto-char origin)
|
||||
(push-mark (point))
|
||||
(goto-char end) ;; end-of-defun
|
||||
(push-mark (point) nil t)
|
||||
(goto-char start) ;; beginning-of-defun
|
||||
(re-search-backward "^\n" (- (point) 1) t)))
|
||||
|
||||
;;; Tag Cut & Paste
|
||||
|
||||
;; To copy a tag, means to put a tag definition into the tag
|
||||
;; ring. To kill a tag, put the tag into the tag ring AND put
|
||||
;; the body of the tag into the kill-ring.
|
||||
;;
|
||||
;; To retrieve a killed tag's text, use C-y (yank), but to retrieve
|
||||
;; the tag as a reference of some sort, use senator-yank-tag.
|
||||
|
||||
(defvar senator-tag-ring (make-ring 20)
|
||||
"Ring of tags for use with cut and paste.")
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-copy-tag ()
|
||||
"Take the current tag, and place it in the tag ring."
|
||||
(interactive)
|
||||
(semantic-fetch-tags)
|
||||
(let ((ft (semantic-obtain-foreign-tag)))
|
||||
(when ft
|
||||
(ring-insert senator-tag-ring ft)
|
||||
(kill-ring-save (semantic-tag-start ft) (semantic-tag-end ft))
|
||||
(when (interactive-p)
|
||||
(message "Use C-y to yank text. Use `senator-yank-tag' for prototype insert."))
|
||||
)
|
||||
ft))
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-kill-tag ()
|
||||
"Take the current tag, place it in the tag ring, and kill it.
|
||||
Killing the tag removes the text for that tag, and places it into
|
||||
the kill ring. Retrieve that text with \\[yank]."
|
||||
(interactive)
|
||||
(let ((ct (senator-copy-tag))) ;; this handles the reparse for us.
|
||||
(kill-region (semantic-tag-start ct)
|
||||
(semantic-tag-end ct))
|
||||
(when (interactive-p)
|
||||
(message "Use C-y to yank text. Use `senator-yank-tag' for prototype insert."))
|
||||
))
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-yank-tag ()
|
||||
"Yank a tag from the tag ring.
|
||||
The form the tag takes is differnet depending on where it is being
|
||||
yanked to."
|
||||
(interactive)
|
||||
(or (ring-empty-p senator-tag-ring)
|
||||
(let ((ft (ring-ref senator-tag-ring 0)))
|
||||
(semantic-foreign-tag-check ft)
|
||||
(semantic-insert-foreign-tag ft)
|
||||
(when (interactive-p)
|
||||
(message "Use C-y to recover the yank the text of %s."
|
||||
(semantic-tag-name ft)))
|
||||
)))
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-copy-tag-to-register (register &optional kill-flag)
|
||||
"Copy the current tag into REGISTER.
|
||||
Optional argument KILL-FLAG will delete the text of the tag to the
|
||||
kill ring."
|
||||
(interactive "cTag to register: \nP")
|
||||
(semantic-fetch-tags)
|
||||
(let ((ft (semantic-obtain-foreign-tag)))
|
||||
(when ft
|
||||
(set-register register ft)
|
||||
(if kill-flag
|
||||
(kill-region (semantic-tag-start ft)
|
||||
(semantic-tag-end ft))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-transpose-tags-up ()
|
||||
"Transpose the current tag, and the preceeding tag."
|
||||
(interactive)
|
||||
(semantic-fetch-tags)
|
||||
(let* ((current-tag (semantic-current-tag))
|
||||
(prev-tag (save-excursion
|
||||
(goto-char (semantic-tag-start current-tag))
|
||||
(semantic-find-tag-by-overlay-prev)))
|
||||
(ct-parent (semantic-find-tag-parent-by-overlay current-tag))
|
||||
(pt-parent (semantic-find-tag-parent-by-overlay prev-tag)))
|
||||
(if (not (eq ct-parent pt-parent))
|
||||
(error "Cannot transpose tags"))
|
||||
(let ((txt (buffer-substring (semantic-tag-start current-tag)
|
||||
(semantic-tag-end current-tag)))
|
||||
(line (count-lines (semantic-tag-start current-tag)
|
||||
(point)))
|
||||
(insert-point nil)
|
||||
)
|
||||
(delete-region (semantic-tag-start current-tag)
|
||||
(semantic-tag-end current-tag))
|
||||
(delete-blank-lines)
|
||||
(goto-char (semantic-tag-start prev-tag))
|
||||
(setq insert-point (point))
|
||||
(insert txt)
|
||||
(if (/= (current-column) 0)
|
||||
(insert "\n"))
|
||||
(insert "\n")
|
||||
(goto-char insert-point)
|
||||
(forward-line line)
|
||||
)))
|
||||
|
||||
;;;###autoload
|
||||
(defun senator-transpose-tags-down ()
|
||||
"Transpose the current tag, and the following tag."
|
||||
(interactive)
|
||||
(semantic-fetch-tags)
|
||||
(let* ((current-tag (semantic-current-tag))
|
||||
(next-tag (save-excursion
|
||||
(goto-char (semantic-tag-end current-tag))
|
||||
(semantic-find-tag-by-overlay-next)))
|
||||
(end-pt (point-marker))
|
||||
)
|
||||
(goto-char (semantic-tag-start next-tag))
|
||||
(forward-char 1)
|
||||
(senator-transpose-tags-up)
|
||||
;; I know that the above fcn deletes the next tag, so our pt marker
|
||||
;; will be stable.
|
||||
(goto-char end-pt)))
|
||||
|
||||
;;; Using semantic search in isearch mode
|
||||
|
||||
(defun senator-lazy-highlight-update ()
|
||||
"Force lazy highlight update."
|
||||
(lazy-highlight-cleanup t)
|
||||
(set 'isearch-lazy-highlight-last-string nil)
|
||||
(setq isearch-adjusted t)
|
||||
(isearch-update))
|
||||
|
||||
;; Recent versions of GNU Emacs allow to override the isearch search
|
||||
;; function for special needs, and avoid to advice the built-in search
|
||||
;; function :-)
|
||||
(defun senator-isearch-search-fun ()
|
||||
"Return the function to use for the search.
|
||||
Use a senator search function when semantic isearch mode is enabled."
|
||||
(intern
|
||||
(concat (if senator-isearch-semantic-mode
|
||||
"senator-"
|
||||
"")
|
||||
(cond (isearch-word "word-")
|
||||
(isearch-regexp "re-")
|
||||
(t ""))
|
||||
"search-"
|
||||
(if isearch-forward
|
||||
"forward"
|
||||
"backward"))))
|
||||
|
||||
(defun senator-isearch-toggle-semantic-mode ()
|
||||
"Toggle semantic searching on or off in isearch mode."
|
||||
(interactive)
|
||||
(setq senator-isearch-semantic-mode
|
||||
(not senator-isearch-semantic-mode))
|
||||
(if isearch-mode
|
||||
;; force lazy highlight update
|
||||
(senator-lazy-highlight-update)
|
||||
(message "Isearch semantic mode %s"
|
||||
(if senator-isearch-semantic-mode
|
||||
"enabled"
|
||||
"disabled"))))
|
||||
|
||||
(defvar senator-old-isearch-search-fun nil
|
||||
"Hold previous value of `isearch-search-fun-function'.")
|
||||
|
||||
(defun senator-isearch-mode-hook ()
|
||||
"Isearch mode hook to setup semantic searching."
|
||||
(if (and isearch-mode senator-isearch-semantic-mode)
|
||||
(progn
|
||||
;; When `senator-isearch-semantic-mode' is on save the
|
||||
;; previous `isearch-search-fun-function' and install the
|
||||
;; senator one.
|
||||
(when (and (local-variable-p 'isearch-search-fun-function)
|
||||
(not (local-variable-p 'senator-old-isearch-search-fun)))
|
||||
(set (make-local-variable 'senator-old-isearch-search-fun)
|
||||
isearch-search-fun-function))
|
||||
(set (make-local-variable 'isearch-search-fun-function)
|
||||
'senator-isearch-search-fun))
|
||||
;; When `senator-isearch-semantic-mode' is off restore the
|
||||
;; previous `isearch-search-fun-function'.
|
||||
(when (eq isearch-search-fun-function 'senator-isearch-search-fun)
|
||||
(if (local-variable-p 'senator-old-isearch-search-fun)
|
||||
(progn
|
||||
(set (make-local-variable 'isearch-search-fun-function)
|
||||
senator-old-isearch-search-fun)
|
||||
(kill-local-variable 'senator-old-isearch-search-fun))
|
||||
(kill-local-variable 'isearch-search-fun-function)))))
|
||||
|
||||
;; (add-hook 'isearch-mode-hook 'senator-isearch-mode-hook)
|
||||
;; (add-hook 'isearch-mode-end-hook 'senator-isearch-mode-hook)
|
||||
|
||||
;; ;; Keyboard shortcut to toggle semantic search in isearch mode.
|
||||
;; (define-key isearch-mode-map
|
||||
;; [(control ?,)]
|
||||
;; 'senator-isearch-toggle-semantic-mode)
|
||||
|
||||
;; (defadvice insert-register (around senator activate)
|
||||
;; "Insert contents of register REGISTER as a tag.
|
||||
;; If senator is not active, use the original mechanism."
|
||||
;; (let ((val (get-register (ad-get-arg 0))))
|
||||
;; (if (and senator-minor-mode (interactive-p)
|
||||
;; (semantic-foreign-tag-p val))
|
||||
;; (semantic-insert-foreign-tag val)
|
||||
;; ad-do-it)))
|
||||
|
||||
;; (defadvice jump-to-register (around senator activate)
|
||||
;; "Insert contents of register REGISTER as a tag.
|
||||
;; If senator is not active, use the original mechanism."
|
||||
;; (let ((val (get-register (ad-get-arg 0))))
|
||||
;; (if (and senator-minor-mode (interactive-p)
|
||||
;; (semantic-foreign-tag-p val))
|
||||
;; (progn
|
||||
;; (switch-to-buffer (semantic-tag-buffer val))
|
||||
;; (goto-char (semantic-tag-start val)))
|
||||
;; ad-do-it)))
|
||||
|
||||
(provide 'semantic/senator)
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "loaddefs.el"
|
||||
;; generated-autoload-feature: semantic/loaddefs
|
||||
;; generated-autoload-load-name: "semantic/senator"
|
||||
;; End:
|
||||
|
||||
;;; semantic/senator.el ends here
|
||||
@ -447,13 +447,6 @@ NOTFIRST indicates that this was not the first call in the recursive use."
|
||||
|
||||
;; Symbol completion
|
||||
|
||||
(defvar semantic--completion-cache nil
|
||||
"Internal variable used by `senator-complete-symbol'.")
|
||||
|
||||
(defsubst semantic-symbol-start (pos)
|
||||
"Return the start of the symbol at buffer position POS."
|
||||
(car (nth 2 (semantic-ctxt-current-symbol-and-bounds pos))))
|
||||
|
||||
(defun semantic-find-tag-for-completion (prefix)
|
||||
"Find all tags with name starting with PREFIX.
|
||||
This uses `semanticdb' when available."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user