;;; ebrowse.el --- Emacs C++ class browser & tags facility
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007
-;; Free Software Foundation Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; 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, 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(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)
+(define-obsolete-face-alias 'ebrowse-tree-mark-face 'ebrowse-tree-mark "22.1")
(defface ebrowse-root-class
(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)
+(define-obsolete-face-alias 'ebrowse-root-class-face 'ebrowse-root-class "22.1")
(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)
+(define-obsolete-face-alias 'ebrowse-file-name-face 'ebrowse-file-name "22.1")
(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)
+(define-obsolete-face-alias 'ebrowse-default-face 'ebrowse-default "22.1")
(defface ebrowse-member-attribute
(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)
+(define-obsolete-face-alias 'ebrowse-member-attribute-face
+ 'ebrowse-member-attribute "22.1")
(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)
+(define-obsolete-face-alias 'ebrowse-member-class-face
+ 'ebrowse-member-class "22.1")
(defface ebrowse-progress
(t (:background "blue")))
"*Face for progress indicator."
:group 'ebrowse-faces)
-;; backward-compatibility alias
-(put 'ebrowse-progress-face 'face-alias 'ebrowse-progress)
+(define-obsolete-face-alias 'ebrowse-progress-face 'ebrowse-progress "22.1")
\f
(let (message-log-max)
(when start (setq ebrowse-n-boxes 0))
(setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes))
- (message (concat title ": "
- (propertize (make-string ebrowse-n-boxes
- (if (display-color-p) ?\ ?+))
- 'face 'ebrowse-progress)))))
+ (message "%s: %s" title
+ (propertize (make-string ebrowse-n-boxes
+ (if (display-color-p) ?\ ?+))
+ 'face 'ebrowse-progress))))
\f
;;; Reading a tree from disk
(loop for buffer in (ebrowse-browser-buffer-list)
until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer))
finally do
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(ebrowse-fill-member-table))))
(ebrowse-hs-member-table header))
(kill-all-local-variables)
(use-local-map ebrowse-tree-mode-map)
+ (buffer-disable-undo)
(unless (zerop (buffer-size))
(goto-char (point-min))
- (multiple-value-setq (header tree) (ebrowse-read))
+ (multiple-value-setq (header tree) (values-list (ebrowse-read)))
(message "Sorting. Please be patient...")
(setq tree (ebrowse-sort-tree-list tree))
(erase-buffer)
(message nil))
- (mapcar 'make-local-variable
- '(ebrowse--tags-file-name
- ebrowse--indentation
- ebrowse--tree
- ebrowse--header
- ebrowse--show-file-names-flag
- ebrowse--frozen-flag
- ebrowse--tree-obarray
- revert-buffer-function))
+ (mapc 'make-local-variable
+ '(ebrowse--tags-file-name
+ ebrowse--indentation
+ ebrowse--tree
+ ebrowse--header
+ ebrowse--show-file-names-flag
+ ebrowse--frozen-flag
+ ebrowse--tree-obarray
+ revert-buffer-function))
(setf ebrowse--show-file-names-flag nil
ebrowse--tree-obarray (make-vector 127 0)
(skip-chars-forward " \t*a-zA-Z0-9_")
(setq start (point)
file-name-existing (looking-at "("))
- (delete-region start (save-excursion (end-of-line) (point)))
+ (delete-region start (line-end-position))
(unless file-name-existing
(indent-to ebrowse-source-file-column)
(insert "(" (or (ebrowse-cs-file
(setf ebrowse--show-file-names-flag (not ebrowse--show-file-names-flag))
(let ((old-line (count-lines (point-min) (point))))
(ebrowse-redraw-tree)
- (goto-line old-line)))
+ (goto-char (point-min))
+ (forward-line (1- old-line))))
\f
file-name))
-(defun ebrowse-view-file-other-window (file)
- "View a file FILE in another window.
-This is a replacement for `view-file-other-window' which does not
-seem to work. It should be removed when `view.el' is fixed."
- (interactive)
- (let ((old-arrangement (current-window-configuration))
- (had-a-buf (get-file-buffer file))
- (buf-to-view (find-file-noselect file)))
- (switch-to-buffer-other-window buf-to-view)
- (view-mode-enter old-arrangement
- (and (not had-a-buf)
- (not (buffer-modified-p buf-to-view))
- 'kill-buffer))))
-
-
(defun ebrowse-view-exit-fn (buffer)
"Function called when exiting View mode in BUFFER.
Restore frame configuration active before viewing the file,
and possibly kill the viewed buffer."
(let (exit-action original-frame-configuration)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq original-frame-configuration ebrowse--frame-configuration
exit-action ebrowse--view-exit-action))
;; Delete the frame in which we viewed.
- (mapcar 'delete-frame
- (loop for frame in (frame-list)
- when (not (assq frame original-frame-configuration))
- collect frame))
+ (mapc 'delete-frame
+ (loop for frame in (frame-list)
+ when (not (assq frame original-frame-configuration))
+ collect frame))
(when exit-action
(funcall exit-action buffer))))
(defun ebrowse-view-file-other-frame (file)
"View a file FILE in another frame.
-The new frame is deleted when it is no longer used."
+The new frame is deleted when you quit viewing the file in that frame."
(interactive)
(let ((old-frame-configuration (current-frame-configuration))
- (old-arrangement (current-window-configuration))
(had-a-buf (get-file-buffer file))
(buf-to-view (find-file-noselect file)))
(switch-to-buffer-other-frame buf-to-view)
(and (not had-a-buf)
(not (buffer-modified-p buf-to-view))
'kill-buffer))
- (view-mode-enter old-arrangement 'ebrowse-view-exit-fn)))
-
+ (view-mode-enter (cons (selected-window) (cons (selected-window) t))
+ 'ebrowse-view-exit-fn)))
(defun ebrowse-view/find-file-and-search-pattern
(struc info file tags-file-name &optional view where)
(setq view-mode-hook nil))
(push 'ebrowse-find-pattern view-mode-hook)
(case where
- (other-window (ebrowse-view-file-other-window file))
+ (other-window (view-file-other-window file))
(other-frame (ebrowse-view-file-other-frame file))
(t (view-file file))))
(t
(fillarray (car (cdr map)) 'ebrowse-electric-list-undefined)
(fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined)
(define-key map "\e" submap)
- (define-key map "\C-z" 'suspend-emacs)
+ (define-key map "\C-z" 'suspend-frame)
(define-key map "\C-h" 'Helper-help)
(define-key map "?" 'Helper-describe-bindings)
(define-key map "\C-c" nil)
(kill-all-local-variables)
(use-local-map ebrowse-member-mode-map)
(setq major-mode 'ebrowse-member-mode)
- (mapcar 'make-local-variable
- '(ebrowse--decl-column ;display column
- ebrowse--n-columns ;number of short columns
- ebrowse--column-width ;width of columns above
- ebrowse--show-inherited-flag ;include inherited members?
- ebrowse--filters ;public, protected, private
- ebrowse--accessor ;vars, functions, friends
- ebrowse--displayed-class ;class displayed
- ebrowse--long-display-flag ;display with regexps?
- ebrowse--source-regexp-flag ;show source regexp?
- ebrowse--attributes-flag ;show `virtual' and `inline'
- ebrowse--member-list ;list of members displayed
- ebrowse--tree ;the class tree
- ebrowse--member-mode-strings ;part of mode line
- ebrowse--tags-file-name ;
- ebrowse--header
- ebrowse--tree-obarray
- ebrowse--virtual-display-flag
- ebrowse--inline-display-flag
- ebrowse--const-display-flag
- ebrowse--pure-display-flag
- ebrowse--frozen-flag)) ;buffer not automagically reused
+ (mapc 'make-local-variable
+ '(ebrowse--decl-column ;display column
+ ebrowse--n-columns ;number of short columns
+ ebrowse--column-width ;width of columns above
+ ebrowse--show-inherited-flag ;include inherited members?
+ ebrowse--filters ;public, protected, private
+ ebrowse--accessor ;vars, functions, friends
+ ebrowse--displayed-class ;class displayed
+ ebrowse--long-display-flag ;display with regexps?
+ ebrowse--source-regexp-flag ;show source regexp?
+ ebrowse--attributes-flag ;show `virtual' and `inline'
+ ebrowse--member-list ;list of members displayed
+ ebrowse--tree ;the class tree
+ ebrowse--member-mode-strings ;part of mode line
+ ebrowse--tags-file-name ;
+ ebrowse--header
+ ebrowse--tree-obarray
+ ebrowse--virtual-display-flag
+ ebrowse--inline-display-flag
+ ebrowse--const-display-flag
+ ebrowse--pure-display-flag
+ ebrowse--frozen-flag)) ;buffer not automagically reused
(setq mode-name "Ebrowse-Members"
mode-line-buffer-identification
(propertized-buffer-identification "C++ Members")
accessor (second info)
member (third info))
(multiple-value-setq (tree member on-class)
- (ebrowse-member-info-from-point))
+ (values-list (ebrowse-member-info-from-point)))
(setq accessor ebrowse--accessor))
;; View/find class if on a line containing a class name.
(when on-class
(save-excursion
(let* (start member-info (members (ebrowse-member-table header)))
(multiple-value-bind (class-name member-name)
- (ebrowse-tags-read-member+class-name)
+ (values-list (ebrowse-tags-read-member+class-name))
(unless member-name
(error "No member name at point"))
(if members
is performed that positions point on the member declaration or
definition."
(multiple-value-bind
- (tree header tree-buffer) (ebrowse-choose-tree)
+ (tree header tree-buffer) (values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker))
class-name
info)
(unless name
(multiple-value-setq (class-name name)
- (ebrowse-tags-read-name
- header
- (concat (if view "View" "Find") " member "
- (if definition "definition" "declaration") ": "))))
+ (values-list
+ (ebrowse-tags-read-name
+ header
+ (concat (if view "View" "Find") " member "
+ (if definition "definition" "declaration") ": ")))))
(setq info (ebrowse-tags-choose-class tree header name class-name))
(ebrowse-push-position marker info)
;; Goto the occurrence of the member
Otherwise read a member name from point."
(interactive)
(multiple-value-bind
- (tree header tree-buffer) (ebrowse-choose-tree)
+ (tree header tree-buffer) (values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker)) class-name (name fix-name) info)
(unless name
(multiple-value-setq (class-name name)
- (ebrowse-tags-read-name header
- (concat "Find member list of: "))))
+ (values-list
+ (ebrowse-tags-read-name header
+ (concat "Find member list of: ")))))
(setq info (ebrowse-tags-choose-class tree header name class-name))
(ebrowse-push-position marker info)
(ebrowse-tags-select/create-member-buffer tree-buffer info))))
(interactive)
(let* ((buffer (or (ebrowse-choose-from-browser-buffers)
(error "No tree buffer")))
- (files (save-excursion (set-buffer buffer) (ebrowse-files-table)))
+ (files (with-current-buffer buffer (ebrowse-files-table)))
(file (completing-read "List members in file: " files nil t))
(header (ebrowse-value-in-buffer 'ebrowse--header buffer))
temp-buffer-setup-hook
;; on which tree (s)he wants to operate.
(when initialize
(let ((buffer (or tree-buffer (ebrowse-choose-from-browser-buffers))))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq ebrowse-tags-next-file-list
(ebrowse-files-list (ebrowse-marked-classes-p))
ebrowse-tags-loop-last-file
(interactive)
;; Choose the tree to use if there is more than one.
(multiple-value-bind (tree header tree-buffer)
- (ebrowse-choose-tree)
+ (values-list (ebrowse-choose-tree))
(unless tree
(error "No class tree"))
;; Get the member name NAME (class-name is ignored).
(let ((name fix-name) class-name regexp)
(unless name
(multiple-value-setq (class-name name)
- (ebrowse-tags-read-name header "Find calls of: ")))
+ (values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(setq regexp (concat "\\<" name "[ \t]*(")
ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
(fillarray (car (cdr map)) 'ebrowse-electric-position-undefined)
(fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined)
(define-key map "\e" submap)
- (define-key map "\C-z" 'suspend-emacs)
+ (define-key map "\C-z" 'suspend-frame)
(define-key map "\C-h" 'Helper-help)
(define-key map "?" 'Helper-describe-bindings)
(define-key map "\C-c" nil)
(header (copy-ebrowse-hs ebrowse--header))
(tree ebrowse--tree))
(unwind-protect
- (save-excursion
- (set-buffer (setq standard-output temp-buffer))
+ (with-current-buffer (setq standard-output temp-buffer)
(erase-buffer)
(setf (ebrowse-hs-member-table header) nil)
(insert (prin1-to-string header) " ")
- (mapcar 'ebrowse-save-class tree)
+ (mapc 'ebrowse-save-class tree)
(write-file file-name)
(message "Tree written to file `%s'" file-name))
(kill-buffer temp-buffer)
(insert "[ebrowse-ts ")
(prin1 (ebrowse-ts-class class)) ;class name
(insert "(") ;list of subclasses
- (mapcar 'ebrowse-save-class (ebrowse-ts-subclasses class))
+ (mapc 'ebrowse-save-class (ebrowse-ts-subclasses class))
(insert ")")
(dolist (func ebrowse-member-list-accessors)
(prin1 (funcall func class))
(with-output-to-temp-buffer "*Tree Statistics*"
(multiple-value-bind (classes member-functions member-variables
static-functions static-variables)
- (ebrowse-gather-statistics)
+ (values-list (ebrowse-gather-statistics))
(set-buffer standard-output)
(erase-buffer)
(insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n")
\f
;;; Global key bindings
-;;; The following can be used to bind key sequences starting with
-;;; prefix `\C-c\C-m' to browse commands.
+;; The following can be used to bind key sequences starting with
+;; prefix `\C-c\C-m' to browse commands.
(defvar ebrowse-global-map nil
"*Keymap for Ebrowse commands.")
\f
;;; Electric C++ browser buffer menu
-;;; Electric buffer menu customization to display only some buffers
-;;; (in this case Tree buffers). There is only one problem with this:
-;;; If the very first character typed in the buffer menu is a space,
-;;; this will select the buffer from which the buffer menu was
-;;; invoked. But this buffer is not displayed in the buffer list if
-;;; it isn't a tree buffer. I therefore let the buffer menu command
-;;; loop read the command `p' via `unread-command-char'. This command
-;;; has no effect since we are on the first line of the buffer.
+;; Electric buffer menu customization to display only some buffers
+;; (in this case Tree buffers). There is only one problem with this:
+;; If the very first character typed in the buffer menu is a space,
+;; this will select the buffer from which the buffer menu was
+;; invoked. But this buffer is not displayed in the buffer list if
+;; it isn't a tree buffer. I therefore let the buffer menu command
+;; loop read the command `p' via `unread-command-char'. This command
+;; has no effect since we are on the first line of the buffer.
(defvar electric-buffer-menu-mode-hook nil)
(interactive)
(let* ((maxlin (count-lines (point-min) (point-max)))
(n (min maxlin (+ 2 (string-to-number (this-command-keys))))))
- (goto-line n)
+ (goto-char (point-min))
+ (forward-line (1- n))
(throw 'electric-buffer-menu-select (point))))
\f
(provide 'ebrowse)
-;;; Local variables:
-;;; eval:(put 'ebrowse-output 'lisp-indent-hook 0)
-;;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-;;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0)
-;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
-;;; End:
+;; Local variables:
+;; eval:(put 'ebrowse-output 'lisp-indent-hook 0)
+;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
+;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0)
+;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
+;; End:
-;;; arch-tag: 4fa3c8bf-1771-479b-bcd7-b029c7c9677b
;;; ebrowse.el ends here
HCoop / bpt / emacs.git / blobdiff