;;; 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
+;; Free Software Foundation Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
;; 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
(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)))
(when tree
(ebrowse-redraw-tree)
(set-buffer-modified-p nil))
- (run-hooks 'ebrowse-tree-mode-hook)))
+ (run-mode-hooks 'ebrowse-tree-mode-hook)))
(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 ()
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
(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)
"*Keymap for Ebrowse commands.")
-(defvar ebrowse-global-prefix-key "\C-cb"
+(defvar ebrowse-global-prefix-key "\C-cC-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)))
HCoop / bpt / emacs.git / blobdiff