home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
browser2.zip
/
br-posit.el
< prev
next >
Wrap
Lisp/Scheme
|
1995-02-17
|
11KB
|
348 lines
;;; CLASS BROWSER FOR C++
;;; $Id: br-posit.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.
;;;
;;; Moving in the position stack.
;; 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 'cl-19 "cl")
(require 'backquote)
(require 'electric)
(require 'br-macro)
(require 'br-struc)
;;;
;;; Structures of this kind are the elements of the position stack.
;;;
(defstruct browse-position
filename ; in which file
point ; point in file
target ; T if target of a jump
info) ; (CLASS FUNC MEMBER) jumped to
;;;
;;; Variables for the position stack.
;;;
(defconst browse-tags-max-saved-positions 30
"*Number of markers saved on position stack.")
(defvar browse-tags-position-stack ()
"Stack of markers for BROWSE-TAGS-BACK and BROWSE-TAGS-FORWARD,")
(defvar browse-tags-position-index 0
"Current position in position stack above.")
;;;
;;; Return an identifying string for a given position that can be
;;; printed in the electric position list buffer.
;;;
(defun browse-position-name (position)
(let ((info (browse-position-info position)))
(concat (if (browse-position-target position) "at " "to ")
(class-name (tree-class (first info)))
"::" (member-name (third info)))))
;;;
;;; Position point on POSITION. If VIEW is T, view the position,
;;; otherwise find it.
;;;
(defun browse-position-goto (position &optional view)
(cond ((not view)
(find-file (browse-position-filename position))
(goto-char (browse-position-point position)))
(t
(unwind-protect
(progn
(push (function
(lambda ()
(goto-char (browse-position-point position))))
view-hook)
(view-file (browse-position-filename position)))
(pop view-hook)))))
;;;
;;; Push current position on position stack. Positions in buffers that have
;;; no filenames are not saved.
;;;
(defun browse-tags-push-position (marker info &optional target)
(when (buffer-file-name (marker-buffer marker))
(let ((too-much (- (length browse-tags-position-stack)
browse-tags-max-saved-positions)))
;; Do not let the stack grow to infinity.
(when (plusp too-much)
(setq browse-tags-position-stack
(butlast browse-tags-position-stack too-much)))
;; Push the position.
(push (make-browse-position
:filename (buffer-file-name (marker-buffer marker))
:point (marker-position marker)
:target target
:info info)
browse-tags-position-stack))))
;;;
;;; Advance by INCREMENT in the browser tags position stack.
;;;
(defun browse-tags-position (increment)
(let ((length (length browse-tags-position-stack)))
(when (zerop length)
(error "No positions remembered."))
(setq browse-tags-position-index
(mod (+ increment browse-tags-position-index) length))
(message "Position %d of %d." browse-tags-position-index length)
(browse-position-goto (nth browse-tags-position-index
browse-tags-position-stack))))
;;;
;;; Move backward in the positino stack.
;;; ###autoload
;;;
(defun browse-tags-back (arg)
"Go back N positions in the position stack. N is prefix arg,
default is 1."
(interactive "p")
(browse-tags-position (max 1 arg)))
;;;
;;; Move backward in the positino stack.
;;; ###autoload
;;;
(defun browse-tags-forward (arg)
"Go forward N positions in the position stack. N is prefix arg,
default is 1."
(interactive "p")
(browse-tags-position (min -1 (- arg))))
;;;
;;; Variables for the electric position list mode.
;;;
(defvar browse-electric-position-mode-map ()
"Keymap used in electric position stack window.")
(defvar browse-electric-position-mode-hook nil
"If non-nil, its value is called by browse-electric-position-mode.")
;;;
;;; Initialize keymap for electric position mode.
;;;
(unless browse-electric-position-mode-map
(let ((map (make-keymap))
(submap (make-keymap)))
(setq browse-electric-position-mode-map map)
(cond ((memq 'emacs-19 browse-options)
(fillarray (car (cdr map)) 'browse-electric-position-undefined)
(fillarray (car (cdr submap)) 'browse-electric-position-undefined))
(t
(fillarray map 'browse-electric-position-undefined)
(fillarray submap 'browse-electric-position-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-position-quit)
(define-key map "q" 'browse-electric-position-quit)
(define-key map " " 'browse-electric-position-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-position-view)
(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-position-mode 'mode-class 'special)
(put 'browse-electric-position-undefined 'suppress-keymap t)
;;;
;;; Eletric position list mode.
;;;
(defun browse-electric-position-mode ()
"Mode for electric position buffers. Runs the hook
BROWSE-ELECTRIC-POSITION-MODE-HOOK."
(kill-all-local-variables)
(use-local-map browse-electric-position-mode-map)
(setq mode-name "Electric Position Menu"
mode-line-buffer-identification "Electric Position Menu")
(when (memq 'mode-name mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(setcar (memq 'mode-name mode-line-format) "Positions"))
(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-position-mode)
(run-hooks 'browse-electric-position-mode-hook))
;;;
;;; List positions in a buffer.
;;;
(defun browse-list-positions ()
(set-buffer (get-buffer-create "*Positions*"))
(setq buffer-read-only nil)
(erase-buffer)
(insert "File Point Description\n"
"---- ----- -----------\n")
(dolist (position browse-tags-position-stack)
(insert (file-name-nondirectory (browse-position-filename position)))
(indent-to 15)
(insert (int-to-string (browse-position-point position)))
(indent-to 22)
(insert (browse-position-name position) "\n"))
(setq buffer-read-only t))
;;;
;;; List all positions in the position stack in an electric buffer.
;;; ###autoload
;;;
(defun browse-electric-position-list ()
"List all positions in the position stack in an electric buffer."
(interactive)
(unless browse-tags-position-stack
(error "No positions remembered."))
(let (select buffer window)
(save-window-excursion
(save-window-excursion (browse-list-positions))
(setq window (Electric-pop-up-window "*Positions*")
buffer (window-buffer window))
(shrink-window-if-larger-than-buffer window)
(unwind-protect
(progn
(set-buffer buffer)
(browse-electric-position-mode)
(setq select
(catch 'browse-electric-position-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-position-select
nil
t
'browse-electric-position-looper
(cons first last))))))
(set-buffer buffer)
(bury-buffer buffer)
(message "")))
(when select
(set-buffer buffer)
(browse-electric-goto-position select))
(kill-buffer buffer)))
;;;
;;; Prevent moving point on invalid lines.
;;;
(defun browse-electric-position-looper (state condition)
(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 undefined keys in the keymap.
;;;
(defun browse-electric-position-undefined ()
(interactive)
(message "Type C-h for help, ? for commands, q to quit, Space to execute")
(sit-for 4))
;;;
;;; Leave the electric position list.
;;;
(defun browse-electric-position-quit ()
(interactive)
(throw 'browse-electric-position-select nil))
;;;
;;; Select a position from the list.
;;;
(defun browse-electric-position-select ()
(interactive)
(throw 'browse-electric-position-select (point)))
;;;
;;; Goto the position described by the line point is in.
;;;
(defun browse-electric-goto-position (point &optional view)
(let* ((index (- (count-lines (point-min) point) 2)))
(browse-position-goto (nth index browse-tags-position-stack) view)))
;;;
;;; View the position described by the line point is in.
;;;
(defun browse-electric-position-view ()
(interactive)
(browse-electric-goto-position (point) t))
;; end of `position.el'.