;;; ebrowse.el --- Emacs C++ class browser & tags facility
-;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
-;; Free Software Foundation Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+;; 2002, 2003, 2004, 2005, 2006, 2007
+;; Free Software Foundation Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
:group 'ebrowse)
-(defface ebrowse-tree-mark-face
- '((t (:foreground "red")))
+(defface ebrowse-tree-mark
+ '((((min-colors 88)) (:foreground "red1"))
+ (t (:foreground "red")))
"*The face used for the mark character in the tree."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-tree-mark-face 'face-alias 'ebrowse-tree-mark)
-(defface ebrowse-root-class-face
- '((t (:weight bold :foreground "blue")))
+(defface ebrowse-root-class
+ '((((min-colors 88)) (:weight bold :foreground "blue1"))
+ (t (:weight bold :foreground "blue")))
"*The face used for root classes in the tree."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-root-class-face 'face-alias 'ebrowse-root-class)
-(defface ebrowse-file-name-face
+(defface ebrowse-file-name
'((t (:italic t)))
"*The face for filenames displayed in the tree."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-file-name-face 'face-alias 'ebrowse-file-name)
-(defface ebrowse-default-face
+(defface ebrowse-default
'((t nil))
"*Face for everything else in the tree not having other faces."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-default-face 'face-alias 'ebrowse-default)
-(defface ebrowse-member-attribute-face
- '((t (:foreground "red")))
+(defface ebrowse-member-attribute
+ '((((min-colors 88)) (:foreground "red1"))
+ (t (:foreground "red")))
"*Face used to display member attributes."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-member-attribute-face 'face-alias 'ebrowse-member-attribute)
-(defface ebrowse-member-class-face
+(defface ebrowse-member-class
'((t (:foreground "purple")))
"*Face used to display the class title in member buffers."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-member-class-face 'face-alias 'ebrowse-member-class)
-(defface ebrowse-progress-face
- '((t (:background "blue")))
+(defface ebrowse-progress
+ '((((min-colors 88)) (:background "blue1"))
+ (t (:background "blue")))
"*Face for progress indicator."
:group 'ebrowse-faces)
+;; backward-compatibility alias
+(put 'ebrowse-progress-face 'face-alias 'ebrowse-progress)
\f
(defmacro ebrowse-output (&rest body)
"Eval BODY with a writable current buffer.
Preserve buffer's modified state."
- (let ((modified (gensym "--ebrowse-output--")))
+ (let ((modified (make-symbol "--ebrowse-output--")))
`(let (buffer-read-only (,modified (buffer-modified-p)))
(unwind-protect
(progn ,@body)
(defun ebrowse-class-in-tree (class tree)
"Search for a class with name CLASS in TREE.
-Return the class found, if any. This function is used during the load
-phase where classes appended to a file replace older class
-information."
+If CLASS is found, return the tail of TREE starting at CLASS. This function
+is used during the load phase where classes appended to a file replace older
+class information."
(let ((tclass (ebrowse-ts-class class))
found)
(while (and tree (not found))
- (let ((root (car tree)))
- (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class root))
+ (let ((root-ptr tree))
+ (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class (car root-ptr)))
(ebrowse-qualified-class-name tclass))
- (setq found root))
+ (setq found root-ptr))
(setq tree (cdr tree))))
found))
(message (concat title ": "
(propertize (make-string ebrowse-n-boxes
(if (display-color-p) ?\ ?+))
- 'face 'ebrowse-progress-face)))))
+ 'face 'ebrowse-progress)))))
\f
;;; Reading a tree from disk
(let ((gc-cons-threshold 2000000))
(while (not (progn (skip-chars-forward " \t\n\r") (eobp)))
(let* ((root (read (current-buffer)))
- (old-root (ebrowse-class-in-tree root tree)))
+ (old-root-ptr (ebrowse-class-in-tree root tree)))
(ebrowse-show-progress "Reading data" (null tree))
- (if old-root
- (setf (car old-root) root)
+ (if old-root-ptr
+ (setcar old-root-ptr root)
(push root tree)))))
(garbage-collect)
(list header tree)))
(loop for member-buffer in (ebrowse-same-tree-member-buffer-list)
do (kill-buffer member-buffer))
(erase-buffer)
- (insert-file (or buffer-file-name ebrowse--tags-file-name))
+ (with-no-warnings
+ (insert-file (or buffer-file-name ebrowse--tags-file-name)))
(ebrowse-tree-mode)
(current-buffer)))
(defun ebrowse-member-table (header)
- "Return the member obarray. Build it it hasn't been set up yet.
+ "Return the member obarray. Build it if it hasn't been set up yet.
HEADER is the tree header structure of the class tree."
(when (null (ebrowse-hs-member-table header))
(loop for buffer in (ebrowse-browser-buffer-list)
(when tree
(ebrowse-redraw-tree)
(set-buffer-modified-p nil))
- (run-hooks 'ebrowse-tree-mode-hook)))
+ (run-mode-hooks 'ebrowse-tree-mode-hook)))
(let ((tree (ebrowse-tree-at-point))
start
file-name-existing)
- (unless tree return)
(beginning-of-line)
(skip-chars-forward " \t*a-zA-Z0-9_")
(setq start (point)
(ebrowse-ts-class tree))
"unknown")
")"))
- (ebrowse-set-face start (point) 'ebrowse-file-name-face)
+ (ebrowse-set-face start (point) 'ebrowse-file-name)
(beginning-of-line)
(forward-line 1))))))
(defun ebrowse-set-tree-indentation ()
"Set the indentation width of the tree display."
(interactive)
- (let ((width (string-to-int (read-from-minibuffer
- (concat "Indentation ("
- (int-to-string ebrowse--indentation)
- "): ")))))
+ (let ((width (string-to-number (read-from-minibuffer
+ (concat "Indentation ("
+ (int-to-string ebrowse--indentation)
+ "): ")))))
(when (plusp width)
(setf ebrowse--indentation width)
(ebrowse-redraw-tree))))
;; START will be 0.
(when (and (boundp 'ebrowse-debug)
(symbol-value 'ebrowse-debug))
- (y-or-n-p (format "start = %d" start))
+ (y-or-n-p (format "start = %d? " start))
(y-or-n-p pattern))
(setf found
(loop do (goto-char (max (point-min) (- start offset)))
start end
`(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree
help-echo "double-mouse-1: mark/unmark"))
- (ebrowse-set-face start end 'ebrowse-tree-mark-face))
+ (ebrowse-set-face start end 'ebrowse-tree-mark))
(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
(when (ebrowse-template-p class)
(insert "<>"))
(ebrowse-set-face start (point) (if (zerop level)
- 'ebrowse-root-class-face
- 'ebrowse-default-face))
+ 'ebrowse-root-class
+ 'ebrowse-default))
(setf start-of-class-name start
end-of-class-name (point))
;; If filenames are to be displayed...
(or (ebrowse-cs-file class)
"unknown")
")")
- (ebrowse-set-face start (point) 'ebrowse-file-name-face))
+ (ebrowse-set-face start (point) 'ebrowse-file-name))
(ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
(add-text-properties
start-of-class-name end-of-class-name
truncate-lines t
buffer-read-only t
major-mode 'ebrowse-electric-list-mode)
- (run-hooks 'ebrowse-electric-list-mode-hook))
+ (run-mode-hooks 'ebrowse-electric-list-mode-hook))
(defun ebrowse-list-tree-buffers ()
\f
;;; Member mode
-;;###autoload
+;;;###autoload
(defun ebrowse-member-mode ()
"Major mode for Ebrowse member buffers.
ebrowse--const-display-flag nil
ebrowse--pure-display-flag nil)
(modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
- (run-hooks 'ebrowse-member-mode-hook))
+ (run-mode-hooks 'ebrowse-member-mode-hook))
\f
"Set the column width of the member display.
The new width is read from the minibuffer."
(interactive)
- (let ((width (string-to-int
+ (let ((width (string-to-number
(read-from-minibuffer
(concat "Column width ("
(int-to-string (if ebrowse--long-display-flag
(insert "<>"))
(setq class-name-end (point))
(insert ":\n\n")
- (ebrowse-set-face start (point) 'ebrowse-member-class-face)
+ (ebrowse-set-face start (point) 'ebrowse-member-class)
(add-text-properties
class-name-start class-name-end
'(ebrowse-what class-name
;; is on if not specified as an argument.
(unless class
(setq class (ebrowse-tree-at-point)))
- (with-output-to-temp-buffer ebrowse-member-buffer-name
- (save-excursion
- (set-buffer standard-output)
+ (save-selected-window
+ (if temp-buffer
+ (pop-to-buffer temp-buffer)
+ (pop-to-buffer (get-buffer-create ebrowse-member-buffer-name))
;; If new buffer, set the mode and initial values of locals
- (unless temp-buffer
- (ebrowse-member-mode))
- ;; Set local variables
- (setq ebrowse--member-list (funcall list class)
- ebrowse--displayed-class class
- ebrowse--accessor list
- ebrowse--tree-obarray classes
- ebrowse--frozen-flag stand-alone
- ebrowse--tags-file-name tags-file-name
- ebrowse--header header
- ebrowse--tree tree
- buffer-read-only t)
- (ebrowse-redisplay-member-buffer)
- (current-buffer)))))
+ (ebrowse-member-mode))
+ ;; Set local variables
+ (setq ebrowse--member-list (funcall list class)
+ ebrowse--displayed-class class
+ ebrowse--accessor list
+ ebrowse--tree-obarray classes
+ ebrowse--frozen-flag stand-alone
+ ebrowse--tags-file-name tags-file-name
+ ebrowse--header header
+ ebrowse--tree tree
+ buffer-read-only t)
+ (ebrowse-redisplay-member-buffer)
+ (current-buffer))))
(defun ebrowse-member-display-p (member)
(ebrowse-draw-member-attributes member-struc)
(insert ">")
(ebrowse-set-face start (point)
- 'ebrowse-member-attribute-face)))
+ 'ebrowse-member-attribute)))
(insert " ")
(ebrowse-draw-member-regexp member-struc))))
(insert "\n")
(ebrowse-draw-member-attributes member)
(insert "> ")
(ebrowse-set-face start-of-entry (point)
- 'ebrowse-member-attribute-face))
+ 'ebrowse-member-attribute))
;; insert member name truncated to column width
(setq start-of-name (point))
(insert (substring name 0
(ebrowse-push-position (point-marker) info t))))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-view-declaration ()
"View declaration of member at point."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 0 :view t :definition nil))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-find-declaration ()
"Find declaration of member at point."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition nil))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-view-definition ()
"View definition of member at point."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 0 :view t :definition t))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-find-definition ()
"Find definition of member at point."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 4 :view t :definition nil))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-find-declaration-other-window ()
"Find declaration of member at point in other window."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition nil))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-view-definition-other-window ()
"View definition of member at point in other window."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 4 :view t :definition t))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-find-definition-other-window ()
"Find definition of member at point in other window."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 5 :view t :definition nil))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-find-declaration-other-frame ()
"Find definition of member at point in other frame."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition nil))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-view-definition-other-frame ()
"View definition of member at point in other frame."
(interactive)
(ebrowse-tags-view/find-member-decl/defn 5 :view t :definition t))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-find-definition-other-frame ()
"Find definition of member at point in other frame."
(interactive)
(defun* ebrowse-draw-file-member-info (info &optional (kind ""))
- "Display a line in an the members per file info buffer.
+ "Display a line in the members info buffer.
INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
TREE is the class of the member to display.
ACCESSOR is the accessor symbol of its member list.
(goto-char (point-min))))
-;;###autoload
+;;;###autoload
(defun ebrowse-tags-search (regexp)
"Search for REGEXP in all files in a tree.
If marked classes exist, process marked classes, only.
(defvar ebrowse-electric-position-mode-hook nil
- "If non-nil, its value is called by ebrowse-electric-position-mode.")
+ "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
(unless ebrowse-electric-position-mode-map
truncate-lines t
buffer-read-only t
major-mode 'ebrowse-electric-position-mode)
- (run-hooks 'ebrowse-electric-position-mode-hook))
+ (run-mode-hooks 'ebrowse-electric-position-mode-hook))
(defun ebrowse-draw-position-buffer ()
(defun ebrowse-print-statistics-line (title value)
"Print a line in the statistics buffer.
-TITLE is the title of the line, VALUE is number to be printed
+TITLE is the title of the line, VALUE is a number to be printed
after that."
(insert title)
(indent-to 40)
;;; Global key bindings
;;; The following can be used to bind key sequences starting with
-;;; prefix `\C-cb' to browse commands.
+;;; prefix `\C-c\C-m' to browse commands.
(defvar ebrowse-global-map nil
"*Keymap for Ebrowse commands.")
-(defvar ebrowse-global-prefix-key "\C-cb"
+(defvar ebrowse-global-prefix-key "\C-c\C-m"
"Prefix key for Ebrowse commands.")
"Select the nth entry in the list by the keys 1..9."
(interactive)
(let* ((maxlin (count-lines (point-min) (point-max)))
- (n (min maxlin (+ 2 (string-to-int (this-command-keys))))))
+ (n (min maxlin (+ 2 (string-to-number (this-command-keys))))))
(goto-line n)
(throw 'electric-buffer-menu-select (point))))
(defun ebrowse-install-1-to-9-keys ()
- "Define keys 1..9 to select the 1st to 0nth entry in the list."
+ "Define keys 1..9 to select the 1st to 9nth entry in the list."
(dotimes (i 9)
(define-key (current-local-map) (char-to-string (+ i ?1))
'ebrowse-select-1st-to-9nth)))
;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
;;; End:
+;;; arch-tag: 4fa3c8bf-1771-479b-bcd7-b029c7c9677b
;;; ebrowse.el ends here