home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-posit.el < prev    next >
Lisp/Scheme  |  1995-02-17  |  11KB  |  348 lines
  1. ;;; CLASS BROWSER FOR C++
  2. ;;; $Id: br-posit.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. ;;; Moving in the position stack.
  16.  
  17. ;; This file may be made part of the Emacs distribution at the option
  18. ;; of the FSF.
  19.  
  20. ;; This code is distributed in the hope that it will be useful,
  21. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  22. ;; accepts responsibility to anyone for the consequences of using it
  23. ;; or for whether it serves any particular purpose or works at all,
  24. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  25. ;; License for full details.
  26.  
  27. ;; Everyone is granted permission to copy, modify and redistribute
  28. ;; this code, but only under the conditions described in the
  29. ;; GNU Emacs General Public License.   A copy of this license is
  30. ;; supposed to have been given to you along with GNU Emacs so you
  31. ;; can know your rights and responsibilities.  It should be in a
  32. ;; file named COPYING.  Among other things, the copyright notice
  33. ;; and this notice must be preserved on all copies.
  34.  
  35. (require 'cl-19 "cl")
  36. (require 'backquote)
  37. (require 'electric)
  38. (require 'br-macro)
  39. (require 'br-struc)
  40.  
  41.  
  42. ;;;
  43. ;;; Structures of this kind are the elements of the position stack.
  44. ;;; 
  45.  
  46. (defstruct browse-position
  47.   filename                ; in which file
  48.   point                    ; point in file
  49.   target                ; T if target of a jump
  50.   info)                    ; (CLASS FUNC MEMBER) jumped to
  51.  
  52. ;;;
  53. ;;; Variables for the position stack.
  54. ;;; 
  55.  
  56. (defconst browse-tags-max-saved-positions 30
  57.   "*Number of markers saved on position stack.")
  58.  
  59. (defvar browse-tags-position-stack ()
  60.   "Stack of markers for BROWSE-TAGS-BACK and BROWSE-TAGS-FORWARD,")
  61.  
  62. (defvar browse-tags-position-index 0
  63.   "Current position in position stack above.")
  64.  
  65. ;;;
  66. ;;; Return an identifying string for a given position that can be
  67. ;;; printed in the electric position list buffer.
  68. ;;; 
  69.  
  70. (defun browse-position-name (position)
  71.   (let ((info (browse-position-info position)))
  72.     (concat (if (browse-position-target position) "at " "to ")
  73.         (class-name (tree-class (first info)))
  74.         "::" (member-name (third info)))))
  75.  
  76. ;;;
  77. ;;; Position point on POSITION. If VIEW is T, view the position,
  78. ;;; otherwise find it.
  79. ;;; 
  80.   
  81. (defun browse-position-goto (position &optional view)
  82.   (cond ((not view)
  83.      (find-file (browse-position-filename position))
  84.      (goto-char (browse-position-point position)))
  85.     (t
  86.      (unwind-protect
  87.          (progn
  88.            (push (function 
  89.               (lambda ()
  90.             (goto-char (browse-position-point position))))
  91.              view-hook)
  92.            (view-file (browse-position-filename position)))
  93.        (pop view-hook)))))
  94.  
  95. ;;;
  96. ;;; Push current position on position stack. Positions in buffers that have
  97. ;;; no filenames are not saved.
  98. ;;; 
  99.  
  100. (defun browse-tags-push-position (marker info &optional target)
  101.   (when (buffer-file-name (marker-buffer marker))
  102.     (let ((too-much (- (length browse-tags-position-stack)
  103.                browse-tags-max-saved-positions)))
  104.  
  105.       ;; Do not let the stack grow to infinity.
  106.       (when (plusp too-much)
  107.     (setq browse-tags-position-stack
  108.           (butlast browse-tags-position-stack too-much)))
  109.  
  110.       ;; Push the position.
  111.       (push (make-browse-position
  112.          :filename (buffer-file-name (marker-buffer marker))
  113.          :point (marker-position marker)
  114.          :target target
  115.          :info info) 
  116.         browse-tags-position-stack))))
  117.  
  118. ;;;
  119. ;;; Advance by INCREMENT in the browser tags position stack.
  120. ;;; 
  121.  
  122. (defun browse-tags-position (increment)
  123.   (let ((length (length browse-tags-position-stack)))
  124.     (when (zerop length)
  125.       (error "No positions remembered."))
  126.     (setq browse-tags-position-index
  127.       (mod (+ increment browse-tags-position-index) length))
  128.     (message "Position %d of %d." browse-tags-position-index length)
  129.     (browse-position-goto (nth browse-tags-position-index
  130.                    browse-tags-position-stack))))
  131.  
  132. ;;;
  133. ;;; Move backward in the positino stack.
  134. ;;; ###autoload
  135. ;;; 
  136.  
  137. (defun browse-tags-back (arg)
  138.   "Go back N positions in the position stack. N is prefix arg,
  139. default is 1."
  140.   (interactive "p")
  141.   (browse-tags-position (max 1 arg)))
  142.  
  143. ;;;
  144. ;;; Move backward in the positino stack.
  145. ;;; ###autoload
  146. ;;; 
  147.  
  148. (defun browse-tags-forward (arg)
  149.   "Go forward N positions in the position stack. N is prefix arg,
  150. default is 1."
  151.   (interactive "p")
  152.   (browse-tags-position (min -1 (- arg))))
  153.  
  154.  
  155. ;;;
  156. ;;; Variables for the electric position list mode.
  157. ;;; 
  158.  
  159. (defvar browse-electric-position-mode-map ()
  160.   "Keymap used in electric position stack window.")
  161.  
  162. (defvar browse-electric-position-mode-hook nil
  163.   "If non-nil, its value is called by browse-electric-position-mode.")
  164.  
  165. ;;;
  166. ;;; Initialize keymap for electric position mode.
  167. ;;; 
  168.  
  169. (unless browse-electric-position-mode-map
  170.   (let ((map (make-keymap))
  171.     (submap (make-keymap)))
  172.     (setq browse-electric-position-mode-map map)
  173.     (cond ((memq 'emacs-19 browse-options)
  174.        (fillarray (car (cdr map)) 'browse-electric-position-undefined)
  175.        (fillarray (car (cdr submap)) 'browse-electric-position-undefined))
  176.       (t
  177.        (fillarray map 'browse-electric-position-undefined)
  178.        (fillarray submap 'browse-electric-position-undefined)))
  179.     (define-key map "\e" submap)
  180.     (define-key map "\C-z" 'suspend-emacs)
  181.     (define-key map "\C-h" 'Helper-help)
  182.     (define-key map "?" 'Helper-describe-bindings)
  183.     (define-key map "\C-c" nil)
  184.     (define-key map "\C-c\C-c" 'browse-electric-position-quit)
  185.     (define-key map "q" 'browse-electric-position-quit)
  186.     (define-key map " " 'browse-electric-position-select)
  187.     (define-key map "\C-l" 'recenter)
  188.     (define-key map "\C-u" 'universal-argument)
  189.     (define-key map "\C-p" 'previous-line)
  190.     (define-key map "\C-n" 'next-line)
  191.     (define-key map "p" 'previous-line)
  192.     (define-key map "n" 'next-line)
  193.     (define-key map "v" 'browse-electric-position-view)
  194.     (define-key map "\C-v" 'scroll-up)
  195.     (define-key map "\ev" 'scroll-down)
  196.     (define-key map "\e\C-v" 'scroll-other-window)
  197.     (define-key map "\e>" 'end-of-buffer)
  198.     (define-key map "\e<" 'beginning-of-buffer)
  199.     (define-key map "\e>" 'end-of-buffer)))
  200.  
  201. (put 'browse-electric-position-mode 'mode-class 'special)
  202. (put 'browse-electric-position-undefined 'suppress-keymap t)
  203.  
  204. ;;;
  205. ;;; Eletric position list mode.
  206. ;;; 
  207.  
  208. (defun browse-electric-position-mode ()
  209.   "Mode for electric position buffers. Runs the hook 
  210. BROWSE-ELECTRIC-POSITION-MODE-HOOK."
  211.   (kill-all-local-variables)
  212.   (use-local-map browse-electric-position-mode-map)
  213.   (setq mode-name "Electric Position Menu"
  214.     mode-line-buffer-identification "Electric Position Menu")
  215.   (when (memq 'mode-name mode-line-format)
  216.     (setq mode-line-format (copy-sequence mode-line-format))
  217.     (setcar (memq 'mode-name mode-line-format) "Positions"))
  218.   (make-local-variable 'Helper-return-blurb)
  219.   (setq Helper-return-blurb "return to buffer editing"
  220.     truncate-lines t
  221.     buffer-read-only t
  222.     major-mode 'browse-electric-position-mode)
  223.   (run-hooks 'browse-electric-position-mode-hook))
  224.  
  225. ;;;
  226. ;;; List positions in a buffer.
  227. ;;; 
  228.  
  229. (defun browse-list-positions ()
  230.   (set-buffer (get-buffer-create "*Positions*"))
  231.   (setq buffer-read-only nil)
  232.   (erase-buffer)
  233.   (insert "File           Point  Description\n"
  234.       "----           -----  -----------\n")
  235.   (dolist (position browse-tags-position-stack)
  236.     (insert (file-name-nondirectory (browse-position-filename position)))
  237.     (indent-to 15)
  238.     (insert (int-to-string (browse-position-point position)))
  239.     (indent-to 22)
  240.     (insert (browse-position-name position) "\n"))
  241.   (setq buffer-read-only t))
  242.  
  243. ;;;
  244. ;;; List all positions in the position stack in an electric buffer.
  245. ;;; ###autoload
  246. ;;;
  247.  
  248. (defun browse-electric-position-list ()
  249.   "List all positions in the position stack in an electric buffer."
  250.   (interactive)
  251.   (unless browse-tags-position-stack
  252.     (error "No positions remembered."))
  253.   (let (select buffer window)
  254.     (save-window-excursion
  255.       (save-window-excursion (browse-list-positions))
  256.       (setq window (Electric-pop-up-window "*Positions*")
  257.         buffer (window-buffer window))
  258.       (shrink-window-if-larger-than-buffer window)
  259.       (unwind-protect
  260.       (progn
  261.         (set-buffer buffer)
  262.         (browse-electric-position-mode)
  263.         (setq select
  264.           (catch 'browse-electric-position-select
  265.             (message "<<< Press Space to bury the list >>>")
  266.             (let ((first (progn (goto-char (point-min))
  267.                     (forward-line 2)
  268.                     (point)))
  269.               (last (progn (goto-char (point-max))
  270.                        (forward-line -1)
  271.                        (point)))
  272.               (goal-column 0))
  273.               (goto-char first)
  274.               (Electric-command-loop 'browse-electric-position-select
  275.                          nil
  276.                          t
  277.                          'browse-electric-position-looper
  278.                          (cons first last))))))
  279.     (set-buffer buffer)
  280.     (bury-buffer buffer)
  281.     (message "")))
  282.     (when select
  283.       (set-buffer buffer)
  284.       (browse-electric-goto-position select))
  285.     (kill-buffer buffer)))
  286.  
  287. ;;;
  288. ;;; Prevent moving point on invalid lines.
  289. ;;; 
  290.  
  291. (defun browse-electric-position-looper (state condition)
  292.   (cond ((and condition
  293.           (not (memq (car condition) '(buffer-read-only
  294.                        end-of-buffer
  295.                        beginning-of-buffer))))
  296.      (signal (car condition) (cdr condition)))
  297.     ((< (point) (car state))
  298.      (goto-char (point-min))
  299.      (forward-line 2))
  300.     ((> (point) (cdr state))
  301.      (goto-char (point-max))
  302.      (forward-line -1)
  303.      (if (pos-visible-in-window-p (point-max))
  304.          (recenter -1)))))
  305.  
  306. ;;;
  307. ;;; Function called for undefined keys in the keymap.
  308. ;;; 
  309.  
  310. (defun browse-electric-position-undefined ()
  311.   (interactive)
  312.   (message "Type C-h for help, ? for commands, q to quit, Space to execute")
  313.   (sit-for 4))
  314.  
  315. ;;;
  316. ;;; Leave the electric position list.
  317. ;;; 
  318.  
  319. (defun browse-electric-position-quit ()
  320.   (interactive)
  321.   (throw 'browse-electric-position-select nil))
  322.  
  323. ;;;
  324. ;;; Select a position from the list.
  325. ;;; 
  326.  
  327. (defun browse-electric-position-select ()
  328.   (interactive)
  329.   (throw 'browse-electric-position-select (point)))
  330.  
  331. ;;;
  332. ;;; Goto the position described by the line point is in.
  333. ;;; 
  334.  
  335. (defun browse-electric-goto-position (point &optional view)
  336.   (let* ((index (- (count-lines (point-min) point) 2)))
  337.     (browse-position-goto (nth index browse-tags-position-stack) view)))
  338.  
  339. ;;;
  340. ;;; View the position described by the line point is in.
  341. ;;; 
  342.  
  343. (defun browse-electric-position-view ()
  344.   (interactive)
  345.   (browse-electric-goto-position (point) t))
  346.  
  347. ;; end of `position.el'.
  348.