home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
browser2.zip
/
br-trees.el
< prev
next >
Wrap
Lisp/Scheme
|
1995-02-17
|
8KB
|
262 lines
;;; CLASS BROWSER FOR C++
;;; $Id: br-trees.el,v 3.1 1995/02/17 18:19:36 mmann Exp $
;;;
;;; **********************************************************************
;;; Copyright (C) 1993, 1994 Gerd Moellmann. All rights reserved.
;;; Altenbergstr. 6, D-40235 Duesseldorf, Germany
;;; 100025.3303@COMPUSERVE.COM
;;; Suggestions, comments and requests for improvements are welcome.
;;; **********************************************************************
;;;
;;; This version works with both Emacs version 18 and 19, and I want
;;; to keep it that way. It requires the CL-19 Common Lisp compatibility
;;; package for Emacs 18 and 19.
;;;
;;; This file contains code to handle tree buffer selection.
;;;
;; This file may be made part of the Emacs distribution at the option
;; of the FSF.
;; This code is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; this code, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
(require 'electric)
(require 'browse)
(require 'cl-19 "cl")
(require 'backquote)
(require 'br-macro)
(require 'br-struc)
(require 'br-tree)
;;;
;;; Some commands operating on class trees require the selection of
;;; a buffer if more than one tree is loaded. Instead of using a
;;; completion list, it is much more convenient to let the user choose
;;; the buffer from an electric buffer list.
;;;
(defvar browse-electric-list-mode-map ()
"Keymap used in electric buffer list window.")
(defvar browse-electric-list-mode-hook nil
"If non-nil, its value is called by browse-electric-position-mode.")
;;;
;;; Initialize keymap.
;;;
(unless browse-electric-list-mode-map
(let ((map (make-keymap))
(submap (make-keymap)))
(setq browse-electric-list-mode-map map)
(cond ((memq 'emacs-19 browse-options)
(fillarray (car (cdr map)) 'browse-electric-list-undefined)
(fillarray (car (cdr submap)) 'browse-electric-list-undefined))
(t
(fillarray map 'browse-electric-list-undefined)
(fillarray submap 'browse-electric-list-undefined)))
(define-key map "\e" submap)
(define-key map "\C-z" 'suspend-emacs)
(define-key map "\C-h" 'Helper-help)
(define-key map "?" 'Helper-describe-bindings)
(define-key map "\C-c" nil)
(define-key map "\C-c\C-c" 'browse-electric-list-quit)
(define-key map "q" 'browse-electric-list-quit)
(define-key map " " 'browse-electric-list-select)
(define-key map "\C-l" 'recenter)
(define-key map "\C-u" 'universal-argument)
(define-key map "\C-p" 'previous-line)
(define-key map "\C-n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "n" 'next-line)
(define-key map "v" 'browse-electric-view-buffer)
(define-key map "\C-v" 'scroll-up)
(define-key map "\ev" 'scroll-down)
(define-key map "\e\C-v" 'scroll-other-window)
(define-key map "\e>" 'end-of-buffer)
(define-key map "\e<" 'beginning-of-buffer)
(define-key map "\e>" 'end-of-buffer)))
(put 'browse-electric-list-mode 'mode-class 'special)
(put 'browse-electric-list-undefined 'suppress-keymap t)
;;;
;;; Mode for electric tree list mode.
;;;
(defun browse-electric-list-mode ()
(kill-all-local-variables)
(use-local-map browse-electric-list-mode-map)
(setq mode-name "Electric Position Menu"
mode-line-buffer-identification "Electric Tree Menu")
(when (memq 'mode-name mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
(make-local-variable 'Helper-return-blurb)
(setq Helper-return-blurb "return to buffer editing"
truncate-lines t
buffer-read-only t
major-mode 'browse-electric-list-mode)
(run-hooks 'browse-electric-list-mode-hook))
;;;
;;; Display list of different trees.
;;;
(defun browse-list-tree-buffers ()
(set-buffer (get-buffer-create "*Tree Buffers*"))
(setq buffer-read-only nil)
(erase-buffer)
(insert "Tree\n"
"----\n")
(dolist (buffer (browse-different-tree-buffers))
(insert (buffer-name buffer) "\n"))
(setq buffer-read-only t))
;;;
;;; Return a buffer containing a tree or NIL if no tree found or
;;; canceled.
;;;
;;;###autoload
(defun browse-electric-choose-tree ()
(interactive)
(unless (car (browse-different-tree-buffers))
(error "No tree buffers."))
(let (select buffer window)
(save-window-excursion
(save-window-excursion (browse-list-tree-buffers))
(setq window (Electric-pop-up-window "*Tree Buffers*")
buffer (window-buffer window))
(shrink-window-if-larger-than-buffer window)
(unwind-protect
(progn
(set-buffer buffer)
(browse-electric-list-mode)
(setq select
(catch 'browse-electric-list-select
(message "<<< Press Space to bury the list >>>")
(let ((first (progn (goto-char (point-min))
(forward-line 2)
(point)))
(last (progn (goto-char (point-max))
(forward-line -1)
(point)))
(goal-column 0))
(goto-char first)
(Electric-command-loop 'browse-electric-list-select
nil
t
'browse-electric-list-looper
(cons first last))))))
(set-buffer buffer)
(bury-buffer buffer)
(message "")))
(when select
(set-buffer buffer)
(setq select (browse-electric-get-buffer select)))
(kill-buffer buffer)
select))
;;;
;;; Electric looper function preventing the cursor from moving
;;; into invalid regions of the buffer.
;;;
(defun browse-electric-list-looper (state condition)
"Prevent cursor from moving beyond the buffer end and into the title
lines."
(cond ((and condition
(not (memq (car condition) '(buffer-read-only
end-of-buffer
beginning-of-buffer))))
(signal (car condition) (cdr condition)))
((< (point) (car state))
(goto-char (point-min))
(forward-line 2))
((> (point) (cdr state))
(goto-char (point-max))
(forward-line -1)
(if (pos-visible-in-window-p (point-max))
(recenter -1)))))
;;;
;;; Function called for keys that are undefined.
;;;
(defun browse-electric-list-undefined ()
(interactive)
(message "Type C-h for help, ? for commands, q to quit, Space to select.")
(sit-for 4))
;;;
;;; Quit the buffer.
;;;
(defun browse-electric-list-quit ()
"Discard the position list."
(interactive)
(throw 'browse-electric-list-select nil))
;;;
;;; Select a tree.
;;;
(defun browse-electric-list-select ()
"Select a position from the list."
(interactive)
(throw 'browse-electric-list-select (point)))
;;;
;;; Get a buffer corresponding to the line point is in.
;;;
(defun browse-electric-get-buffer (point)
(let* ((index (- (count-lines (point-min) point) 2)))
(nth index (browse-different-tree-buffers))))
;;;
;;; View a buffer for tree.
;;;
(defun browse-electric-view-buffer ()
"View buffer line is on."
(interactive)
(let ((buffer (browse-electric-get-buffer (point))))
(cond (buffer
(view-buffer buffer))
(t
(error "Buffer no longer exists.")))))
;;;
;;; Read a browser buffer name from the minibuffer and return
;;; the buffer of it.
;;;
(defun tree-choose-buffer ()
(let* ((buffers (browse-different-tree-buffers)))
(if buffers
(if (not (second buffers))
(first buffers)
(or (browse-electric-choose-tree) (error "No tree buffer.")))
(let* ((insert-default-directory t)
(file (read-file-name "Find tree: " nil nil t)))
(find-file file)
(get-file-buffer file)))))
;;; end of `treesel.el'.