/tags/SN-NG4.1/snavigator/etc/sn.el
Emacs Lisp | 312 lines | 190 code | 36 blank | 86 comment | 6 complexity | 12acc6eb9783b6637b0c68b07302c8a5 MD5 | raw file
- ;;; sn.el -- Source Navigator interface for Emacs
- ;;; Copyright (C) 1997 Cygnus Solutions
- ;;; Known problems and things to do:
- ;;; * SN tags workalike should work by making phony tags file and
- ;;; using tags-table-format-hooks. Then we'd get all the tags
- ;;; functionality for free.
- ;;; * Should stick a function on find-file-hook that asks each SN
- ;;; session if the new file is part of the session.
- ;;; Constants.
- ;; non-nil if using XEmacs.
- (defconst sn-is-xemacs (string-match "XEmacs" emacs-version))
- ;;; Variable definitions.
- ;; History list for tags finding.
- (defvar sn-history-list nil)
- ;; This holds the connection to SN. It is local to each buffer; this
- ;; lets us have multiple SN projects share an Emacs.
- (defvar sn-process nil)
- (make-variable-buffer-local 'sn-process)
- ;; Name of the current process. This is only set when running a
- ;; function from a process filter. It is only defvar'd because I
- ;; don't like to use variables that aren't declared.
- (defvar sn-current-process nil)
- (defvar sn-minor-mode nil "t if source navigator mode is active")
- (make-variable-buffer-local 'sn-minor-mode)
- (or (assoc 'sn-minor-mode minor-mode-alist)
- (setq minor-mode-alist (cons '(sn-minor-mode " SN") minor-mode-alist)))
- (setplist 'sn-minor-mode (plist-put (symbol-plist 'sn-minor-mode)
- 'permanent-local t))
- (defun sn-minor-mode (arg)
- "Minor mode for working with Source Navigator.
- Adds some commands for looking up stuff in SN:
- \\{sn-keymap}
- This mode is automatically activated when files are opened by SN and cannot
- be activated for other buffers. You can toggle it for SN-related buffers
- though. This lets you access the command bindings that this mode overrides."
- (interactive "P")
- (unless sn-process
- (error "This buffer has no Source Navigator connection"))
- (setq sn-minor-mode (if (null arg) (not sn-minor-mode)
- (> (prefix-numeric-value arg) 0))))
- ;; When we tell SN about a file, we must always send it exactly the
- ;; same name as it sent us. So we stash the original filename here.
- (defvar sn-file-name nil)
- (make-variable-buffer-local 'sn-file-name)
- (defvar sn-keymap nil
- "Keymap for Source Navigator minor mode.")
- (unless sn-keymap
- (setq sn-keymap (make-sparse-keymap))
- (define-key sn-keymap "\M-." 'sn-find-tag)
- (define-key sn-keymap "\C-x4." 'sn-tag-unimplemented)
- (define-key sn-keymap "\C-x5." 'sn-tag-unimplemented)
- (define-key sn-keymap "\M-," 'sn-tag-unimplemented)
- (define-key sn-keymap "\M-\t" 'sn-tag-unimplemented)
- (define-key sn-keymap "\C-c.c" 'sn-classbrowser)
- (define-key sn-keymap "\C-c.h" 'sn-classtree)
- (define-key sn-keymap "\C-c.r" 'sn-retrieve)
- (define-key sn-keymap "\C-c.x" 'sn-xref)
- (cond (sn-is-xemacs
- (define-key sn-keymap '(meta control ?.) 'sn-tag-unimplemented))
- ;; GNU Emacs.
- (t (define-key sn-keymap [\M-\C-.] 'sn-tag-unimplemented))))
- (or (assoc 'sn-minor-mode minor-mode-map-alist)
- (setq minor-mode-map-alist (cons (cons 'sn-minor-mode sn-keymap)
- minor-mode-map-alist)))
- ;;;
- ;;; Commands that the user can run to interact with SN.
- ;;;
- ;; Hide the current project.
- (defun sn-hide-project ()
- "Hide the Source Navigator project associated with this buffer."
- (interactive)
- (sn-send "tkbHideShow withdraw"))
- ;; Like find-tag, but use SN to look up the tag.
- (defun sn-find-tag (tagname)
- "Like find-tag, but use Source Navigator to look up name."
- (interactive
- (progn
- (require 'etags)
- (list (read-string "Find tag: "
- (find-tag-default)
- 'sn-history-list))))
- (sn-send (concat "sn_emacs_display_object "
- (sn-tcl-quote tagname)))
- ;; We know a response is coming. This makes things look a little
- ;; more synchronous.
- (accept-process-output))
- (defun sn-classbrowser (class)
- "Browse the contents of a class in the Source Navigator."
- (interactive
- (progn
- (require 'etags)
- (list (read-string "Browse class: "
- (find-tag-default)
- 'sn-history-list))))
- (sn-send (concat "sn_classbrowser " (sn-tcl-quote class))))
- (defun sn-classtree (class)
- "Browse a class in the Source Navigator hierarchy browser."
- (interactive
- (progn
- (require 'etags)
- (list (read-string "Browse class: "
- (find-tag-default)
- 'sn-history-list))))
- (sn-send (concat "sn_classtree " (sn-tcl-quote class))))
- (defun sn-retrieve (pattern)
- "Tell Source Navigator to retrieve all symbols matching pattern.
- If there is only one match SN will take Emacs there. If there are
- several they are listed in a pop-up where you can select one to edit."
- (interactive
- (progn
- (require 'etags)
- (list (read-string "Retrieve pattern: "
- (find-tag-default)
- 'sn-history-list))))
- (sn-send (concat "sn_retrieve_symbol " (sn-tcl-quote pattern) " all")))
- (defun sn-xref (symbol)
- "Look up a symbol in the Source Navigator cross-referencer."
- (interactive
- (progn
- (require 'etags)
- (list (read-string "Xref symbol: "
- (find-tag-default)
- 'sn-history-list))))
- (sn-send (concat "sn_xref both " (sn-tcl-quote symbol))))
- (defun sn-tag-unimplemented ()
- "Bound to tags-finding keys that Source Navigator can't (yet) handle."
- (interactive)
- (error "this keybinding is unimplemented in Source Navigator"))
- ;; find-tag-other-frame and find-tag-other-window versions are harder
- ;; to do; there is a synchronization problem here.
- ;; (defun sn-find-tag-other-frame)
- ;;(defun sn-find-tag-other-window)
- ;; (defun sn-find-tag-regexp) ; FIXME do it?
- ;; FIXME what about tags-query-replace, tags-loop-continue,
- ;; tags-search, tags-table-files, find-tag-hook, find-tag-noselect?
- ;; Turn off menus for now. Why bother when there is only one item?
- ; (progn
- ; (define-key sn-keymap [menu-bar SN] (cons "SN" (make-sparse-keymap)))
- ; (define-key sn-keymap [menu-bar SN hide] '("Hide project"
- ; . sn-hide-project)))
- ; )
- ;;;
- ;;; Internal functions that can talk to SN.
- ;;;
- ;; Connect to Source Navigator. Arguments are:
- ;; * TMPFILENAME - a temp file containing some lisp code; remove it
- ;; here. This can be nil, meaning no file exists.
- ;; * HOSTNAME - name of host to connect to
- ;; * DIRECTORY - directory where temp file might be (if not absolute)
- ;; * PORT - port to connect to
- (defun sn-startup (tmpfilename hostname directory port)
- (save-excursion
- (let ((buffer (generate-new-buffer " sn")))
- (set-buffer buffer)
- (setq sn-process (open-network-stream "sn" buffer hostname port))
- (process-kill-without-query sn-process nil)
- (set-process-filter sn-process 'sn-filter)
- (set-process-sentinel sn-process 'sn-sentinel)
- (and tmpfilename
- (delete-file (expand-file-name tmpfilename directory))))))
- ;; This quoting is sufficient to protect eg a filename from any sort
- ;; of expansion or splitting. Tcl quoting sure sucks.
- (defun sn-tcl-quote (string)
- (mapconcat (function (lambda (char)
- (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;))
- (concat "\\" (char-to-string char))
- (char-to-string char))))
- string ""))
- ;; Send a command to SN.
- (defun sn-send (string)
- (process-send-string sn-process (concat string "\n")))
- ;; This is run on a hook after a file is saved. If we have to, we
- ;; notify the appropriate SN.
- (defun sn-after-save ()
- (if sn-minor-mode
- (sn-send (concat "sn_parse_uptodate " (sn-tcl-quote sn-file-name)
- " 0")))) ; Disable annoying popup.
- ;; This is the process filter for reading from SN. It just tries to
- ;; read the process buffer as a lisp object; when the read succeeds,
- ;; the result is evalled.
- (defun sn-filter (proc string)
- ;; Only do the work if the process buffer is alive.
- (if (buffer-name (process-buffer proc))
- (let ((inhibit-quit t)
- (sn-current-process proc)
- form form-list)
- (save-match-data
- (save-excursion
- (set-buffer (process-buffer proc))
- ;; If process marker not already set, we must set it.
- ;; This seems to contradict the docs; go figure.
- (or (marker-position (process-mark proc))
- (set-marker (process-mark proc) (point-min)))
- (goto-char (process-mark proc))
- (insert string)
- (set-marker (process-mark proc) (point))
- (goto-char (point-min))
- ;; Note that we only catch end-of-file. invalid-read-syntax
- ;; we let through; that indicates an SN bug that we really
- ;; want to see.
- (while (progn
- (setq form (condition-case nil
- (read (current-buffer))
- (end-of-file nil)))
- form)
- ;; Remove the stuff we've read.
- (delete-region (point-min) (point))
- (setq form-list (cons form form-list)))))
- ;; Now go through each form on our list and eval it. We do
- ;; this outside the save-excursion because we want the
- ;; expression to be able to move point around. We also turn
- ;; C-g back on.
- (nreverse form-list)
- (setq inhibit-quit nil)
- (while form-list
- (eval (car form-list))
- (setq form-list (cdr form-list))))))
- ;; This is run when the SN connection dies. We go through each buffer
- ;; and do some cleaning up. We also remove our own process buffer.
- (defun sn-sentinel (process event)
- (save-excursion
- (let ((b-list (buffer-list)))
- (while b-list
- (set-buffer (car b-list))
- (if (eq sn-process process)
- (progn
- ;; This buffer belongs to the current invocation. Close
- ;; down.
- (setq sn-process nil)
- (setq sn-minor-mode nil)))
- (setq b-list (cdr b-list)))))
- (kill-buffer (process-buffer process)))
- ;;;
- ;;; Functions that are run by SN. These functions can assume that
- ;;; sn-current-process is set, if they like.
- ;;;
- ;; Sent by SN when we should visit a file.
- ;; Arguments are:
- ;; * DIRECTORY - base directory of project
- ;; * PARTIAL-FILE - possibly-relative filename
- ;; * LINE, COLUMN - where cursor should end up
- ;; * STATE - either "normal" or "disabled"; the latter means read-only
- (defun sn-visit (directory partial-file line column state)
- (let* ((file (expand-file-name partial-file directory))
- (obuf (get-file-buffer file)))
- (cond (obuf (switch-to-buffer obuf)
- (push-mark))
- (t (set-buffer (if (string= state "disabled")
- (find-file-read-only file)
- (find-file file))))))
- (setq sn-process sn-current-process)
- (goto-line line)
- (forward-char column)
- (setq sn-minor-mode t)
- (setq sn-file-name partial-file)
- (add-hook 'after-save-hook 'sn-after-save nil t))
- ;; This command is sent by SN when a buffer we have should be put into
- ;; SN mode. It actually sends a list of (possibly relative) filenames
- ;; and the project's root directory.
- (defun sn-mark-for-project (directory file-list)
- (save-excursion
- (let (buffer
- file)
- (while file-list
- (setq file (expand-file-name (car file-list) directory))
- (setq buffer (get-file-buffer file))
- (if buffer
- (progn
- (set-buffer buffer)
- (if (not sn-minor-mode)
- (progn
- (setq sn-minor-mode t)
- (setq sn-process sn-current-process)))))
- (setq file-list (cdr file-list))))))
- (provide 'sn)
- ;;; sn.el ends here