home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-trees.el < prev    next >
Lisp/Scheme  |  1995-02-17  |  8KB  |  262 lines
  1. ;;; CLASS BROWSER FOR C++
  2. ;;; $Id: br-trees.el,v 3.1 1995/02/17 18:19:36 mmann Exp $
  3. ;;;
  4. ;;; **********************************************************************
  5. ;;; Copyright (C) 1993, 1994 Gerd Moellmann. All rights reserved.
  6. ;;; Altenbergstr. 6, D-40235 Duesseldorf, Germany
  7. ;;; 100025.3303@COMPUSERVE.COM
  8. ;;; Suggestions, comments and requests for improvements are welcome.
  9. ;;; **********************************************************************
  10. ;;;
  11. ;;; This version works with both Emacs version 18 and 19, and I want
  12. ;;; to keep it that way. It requires the CL-19 Common Lisp compatibility
  13. ;;; package for Emacs 18 and 19.
  14. ;;;
  15. ;;; This file contains code to handle tree buffer selection.
  16. ;;; 
  17.  
  18. ;; This file may be made part of the Emacs distribution at the option
  19. ;; of the FSF.
  20.  
  21. ;; This code is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  23. ;; accepts responsibility to anyone for the consequences of using it
  24. ;; or for whether it serves any particular purpose or works at all,
  25. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  26. ;; License for full details.
  27.  
  28. ;; Everyone is granted permission to copy, modify and redistribute
  29. ;; this code, but only under the conditions described in the
  30. ;; GNU Emacs General Public License.   A copy of this license is
  31. ;; supposed to have been given to you along with GNU Emacs so you
  32. ;; can know your rights and responsibilities.  It should be in a
  33. ;; file named COPYING.    Among other things, the copyright notice
  34. ;; and this notice must be preserved on all copies.
  35.  
  36. (require 'electric)
  37. (require 'browse)
  38. (require 'cl-19 "cl")
  39. (require 'backquote)
  40. (require 'br-macro)
  41. (require 'br-struc)
  42. (require 'br-tree)
  43.  
  44.  
  45. ;;; 
  46. ;;; Some commands operating on class trees require the selection of
  47. ;;; a buffer if more than one tree is loaded. Instead of using a
  48. ;;; completion list, it is much more convenient to let the user choose
  49. ;;; the buffer from an electric buffer list.
  50. ;;; 
  51.  
  52. (defvar browse-electric-list-mode-map ()
  53.   "Keymap used in electric buffer list window.")
  54.  
  55. (defvar browse-electric-list-mode-hook nil
  56.   "If non-nil, its value is called by browse-electric-position-mode.")
  57.  
  58. ;;;
  59. ;;; Initialize keymap.
  60. ;;; 
  61.  
  62. (unless browse-electric-list-mode-map
  63.   (let ((map (make-keymap))
  64.     (submap (make-keymap)))
  65.     (setq browse-electric-list-mode-map map)
  66.     (cond ((memq 'emacs-19 browse-options)
  67.        (fillarray (car (cdr map)) 'browse-electric-list-undefined)
  68.        (fillarray (car (cdr submap)) 'browse-electric-list-undefined))
  69.       (t
  70.        (fillarray map 'browse-electric-list-undefined)
  71.        (fillarray submap 'browse-electric-list-undefined)))
  72.     (define-key map "\e" submap)
  73.     (define-key map "\C-z" 'suspend-emacs)
  74.     (define-key map "\C-h" 'Helper-help)
  75.     (define-key map "?" 'Helper-describe-bindings)
  76.     (define-key map "\C-c" nil)
  77.     (define-key map "\C-c\C-c" 'browse-electric-list-quit)
  78.     (define-key map "q" 'browse-electric-list-quit)
  79.     (define-key map " " 'browse-electric-list-select)
  80.     (define-key map "\C-l" 'recenter)
  81.     (define-key map "\C-u" 'universal-argument)
  82.     (define-key map "\C-p" 'previous-line)
  83.     (define-key map "\C-n" 'next-line)
  84.     (define-key map "p" 'previous-line)
  85.     (define-key map "n" 'next-line)
  86.     (define-key map "v" 'browse-electric-view-buffer)
  87.     (define-key map "\C-v" 'scroll-up)
  88.     (define-key map "\ev" 'scroll-down)
  89.     (define-key map "\e\C-v" 'scroll-other-window)
  90.     (define-key map "\e>" 'end-of-buffer)
  91.     (define-key map "\e<" 'beginning-of-buffer)
  92.     (define-key map "\e>" 'end-of-buffer)))
  93.  
  94. (put 'browse-electric-list-mode 'mode-class 'special)
  95. (put 'browse-electric-list-undefined 'suppress-keymap t)
  96.  
  97. ;;;
  98. ;;; Mode for electric tree list mode.
  99. ;;; 
  100.  
  101. (defun browse-electric-list-mode ()
  102.   (kill-all-local-variables)
  103.   (use-local-map browse-electric-list-mode-map)
  104.   (setq mode-name "Electric Position Menu"
  105.     mode-line-buffer-identification "Electric Tree Menu")
  106.   (when (memq 'mode-name mode-line-format)
  107.     (setq mode-line-format (copy-sequence mode-line-format))
  108.     (setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
  109.   (make-local-variable 'Helper-return-blurb)
  110.   (setq Helper-return-blurb "return to buffer editing"
  111.     truncate-lines t
  112.     buffer-read-only t
  113.     major-mode 'browse-electric-list-mode)
  114.   (run-hooks 'browse-electric-list-mode-hook))
  115.  
  116. ;;;
  117. ;;; Display list of different trees.
  118. ;;; 
  119.  
  120. (defun browse-list-tree-buffers ()
  121.   (set-buffer (get-buffer-create "*Tree Buffers*"))
  122.   (setq buffer-read-only nil)
  123.   (erase-buffer)
  124.   (insert "Tree\n"
  125.       "----\n")
  126.   (dolist (buffer (browse-different-tree-buffers))
  127.     (insert (buffer-name buffer) "\n"))
  128.   (setq buffer-read-only t))
  129.  
  130. ;;;
  131. ;;; Return a buffer containing a tree or NIL if no tree found or
  132. ;;; canceled.
  133. ;;; 
  134.  
  135. ;;;###autoload
  136. (defun browse-electric-choose-tree ()
  137.   (interactive)
  138.   (unless (car (browse-different-tree-buffers))
  139.     (error "No tree buffers."))
  140.   (let (select buffer window)
  141.     (save-window-excursion
  142.       (save-window-excursion (browse-list-tree-buffers))
  143.       (setq window (Electric-pop-up-window "*Tree Buffers*")
  144.         buffer (window-buffer window))
  145.       (shrink-window-if-larger-than-buffer window)
  146.       (unwind-protect
  147.       (progn
  148.         (set-buffer buffer)
  149.         (browse-electric-list-mode)
  150.         (setq select
  151.           (catch 'browse-electric-list-select
  152.             (message "<<< Press Space to bury the list >>>")
  153.             (let ((first (progn (goto-char (point-min))
  154.                     (forward-line 2)
  155.                     (point)))
  156.               (last (progn (goto-char (point-max))
  157.                        (forward-line -1)
  158.                        (point)))
  159.               (goal-column 0))
  160.               (goto-char first)
  161.               (Electric-command-loop 'browse-electric-list-select
  162.                          nil
  163.                          t
  164.                          'browse-electric-list-looper
  165.                          (cons first last))))))
  166.     (set-buffer buffer)
  167.     (bury-buffer buffer)
  168.     (message "")))
  169.     (when select
  170.       (set-buffer buffer)
  171.       (setq select (browse-electric-get-buffer select)))
  172.     (kill-buffer buffer)
  173.     select))
  174.  
  175. ;;;
  176. ;;; Electric looper function preventing the cursor from moving
  177. ;;; into invalid regions of the buffer.
  178. ;;; 
  179.  
  180. (defun browse-electric-list-looper (state condition)
  181.   "Prevent cursor from moving beyond the buffer end and into the title
  182. lines."
  183.   (cond ((and condition
  184.           (not (memq (car condition) '(buffer-read-only
  185.                        end-of-buffer
  186.                        beginning-of-buffer))))
  187.      (signal (car condition) (cdr condition)))
  188.     ((< (point) (car state))
  189.      (goto-char (point-min))
  190.      (forward-line 2))
  191.     ((> (point) (cdr state))
  192.      (goto-char (point-max))
  193.      (forward-line -1)
  194.      (if (pos-visible-in-window-p (point-max))
  195.          (recenter -1)))))
  196.  
  197. ;;;
  198. ;;; Function called for keys that are undefined.
  199. ;;; 
  200.  
  201. (defun browse-electric-list-undefined ()
  202.   (interactive)
  203.   (message "Type C-h for help, ? for commands, q to quit, Space to select.")
  204.   (sit-for 4))
  205.  
  206. ;;;
  207. ;;; Quit the buffer.
  208. ;;; 
  209.  
  210. (defun browse-electric-list-quit ()
  211.   "Discard the position list."
  212.   (interactive)
  213.   (throw 'browse-electric-list-select nil))
  214.  
  215. ;;;
  216. ;;; Select a tree.
  217. ;;; 
  218.  
  219. (defun browse-electric-list-select ()
  220.   "Select a position from the list."
  221.   (interactive)
  222.   (throw 'browse-electric-list-select (point)))
  223.  
  224. ;;;
  225. ;;; Get a buffer corresponding to the line point is in.
  226. ;;; 
  227.  
  228. (defun browse-electric-get-buffer (point)
  229.   (let* ((index (- (count-lines (point-min) point) 2)))
  230.     (nth index (browse-different-tree-buffers))))
  231.  
  232. ;;;
  233. ;;; View a buffer for tree.
  234. ;;; 
  235.  
  236. (defun browse-electric-view-buffer ()
  237.   "View buffer line is on."
  238.   (interactive)
  239.   (let ((buffer (browse-electric-get-buffer (point))))
  240.     (cond (buffer
  241.        (view-buffer buffer))
  242.       (t
  243.        (error "Buffer no longer exists.")))))
  244.  
  245. ;;;
  246. ;;; Read a browser buffer name from the minibuffer and return
  247. ;;; the buffer of it.
  248. ;;; 
  249.  
  250. (defun tree-choose-buffer ()
  251.   (let* ((buffers (browse-different-tree-buffers)))
  252.     (if buffers
  253.     (if (not (second buffers))
  254.         (first buffers)
  255.       (or (browse-electric-choose-tree) (error "No tree buffer.")))
  256.       (let* ((insert-default-directory t)
  257.          (file (read-file-name "Find tree: " nil nil t)))
  258.     (find-file file)
  259.     (get-file-buffer file)))))
  260.  
  261. ;;; end of `treesel.el'.
  262.