home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
p
/
plbin.zip
/
pl
/
lisp
/
qphelp.el
< prev
next >
Wrap
Lisp/Scheme
|
1992-05-26
|
7KB
|
192 lines
;;; SCCS: @(#)90/09/25 qphelp.el 2.8
;;; Quintus Prolog - GNU Emacs Interface
;;; Support Functions
;;;
;;; Consolidated by Sitaram Muralidhar
;;;
;;; sitaram@quintus.com
;;; Quintus Computer Systems, Inc.
;;; 2 May 1989
;;;
;;; This file defines functions that support the Quintus Prolog - GNU Emacs
;;; interface.
;;;
;;; Acknowledgements
;;;
;;; This interface was made possible by contributions from Fernando
;;; Pereira and various customers of Quintus Computer Systems, Inc.,
;;; based on code for Quintus's Unipress Emacs interface.
;;;
;;; Note: there may be a problem using Quintus Prolog help under X windows.
;;; If the emacs window is resized or moved after help is invocated, restoring
;;; the previous window configuration will result in an error.
(provide 'qphelp)
(qprequire 'qphelp-functions)
; Quintus Prolog Help System file types.
;
(defconst MENU "{menu}")
(defconst TEXT "{text}")
(defconst SHELL "{shell}")
(defconst HELP "{help}")
(defconst Prolog-buffer "*prolog*")
; Constants
;
(defconst NOERROR t)
(defconst EMPTY '())
; Initialize Variables.
;
(defvar *state* '()
"List of buffer states, i.e. (current-buffer point).")
(defvar current-file nil
"The help file we are now looking for; used for error reporting.")
(defvar Quintus-help-key-map nil "Local keymap for Prolog menu help.")
(defvar Quintus-text-key-map nil "Local keymap for Prolog text help.")
; buffer:
; Quintus-help-system: for help and text interaction.
;
(defvar Quintus-help-system "*Quintus-Help-System*"
"Buffer name used during a Quintus Prolog help session.")
(defmacro error-occurred (&rest body)
(list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
(defun push-state (buffer point)
"Save the current buffer and point location."
(setq *state* (append (list (cons buffer point)) *state*)))
(defun pop-state ()
"pop to the most recent buffer. If we are returning to the
top level, return the point to the end of the buffer."
(kill-buffer (current-buffer))
(while (error-occurred (pop-to-buffer (car (car *state*))))
; in case intermediate buffers have been killed
(setq *state* (cdr *state*)))
(if (equal (buffer-name (car (car *state*))) "*prolog*")
(goto-char (point-max)) ; then part
(goto-char (cdr (car *state*)))) ; else part
(setq *state* (cdr *state*)))
(defun initialize-state ()
"Initilize variables with each invocation from Quintus Prolog."
(if (string-equal (buffer-name) Prolog-buffer)
(setq *state* '())))
(defun @help (file)
"Help executive for Quintus Prolog."
(initialize-state)
(push-state (current-buffer) (point))
(process-file file))
(defun @manual (file)
"Manual executive for Quintus Prolog."
(initialize-state)
(push-state (current-buffer) (point))
(process-file file))
(defun process-file (file)
"Process a help or manual query from Quintus Prolog"
(switch-to-buffer-other-window (generate-new-buffer Quintus-help-system))
(erase-buffer)
(if (error-occurred (insert-file file)) ;read the file into an empty buffer
(message "%s" (concat "There is no information "
"currently available on this topic."))
(progn (setq current-file file) ; save current file for error reporting
(goto-char (point-min)) ; goto top of file
(initialize)))) ; initialize the window
(defun initialize ()
"Initiailzations performed on entry to a buffer. Different actions are
performed depending whether the file is {menu} or {text}."
(cond ((file-type MENU) (progn
(delete-type-marker) ;remove the type marker
(define-local-key-map MENU) ;define local key map
(find-next-entry))) ;go to first entry
((file-type TEXT) (progn
(delete-type-marker) ;delete type marker
(define-local-key-map TEXT))) ;define local key map
(t (message "%s" (concat "error malformed help/manual "
"file: type marker not found."))))
(toggle-read-only))
(defun define-local-key-map (type)
"Select a key map for either menu or text files."
(cond ((string-equal type MENU)
(progn
(Define-Quintus-help-keys)
(use-local-map Quintus-help-key-map)))
((string-equal type TEXT)
(progn
(Define-Quintus-text-keys)
(use-local-map Quintus-text-key-map)))
((string-equal type SHELL)
(progn
(Define-Quintus-help-keys)
(use-local-map Quintus-help-key-map)))
(t (message "define-local-key-map: illegal map specifer: %s", type))))
(defun Define-Quintus-help-keys ()
(if (equal Quintus-help-key-map nil)
(progn
(setq Quintus-help-key-map (make-keymap))
(suppress-keymap Quintus-help-key-map)
(Quintus-help-key-map))))
(defun Define-Quintus-text-keys ()
(if (equal Quintus-text-key-map nil)
(progn
(setq Quintus-text-key-map (make-keymap))
(suppress-keymap Quintus-text-key-map)
(Quintus-text-key-map))))
(defun Quintus-text-key-map ()
"Define the local key for The Quintus Prolog Text System."
(define-key Quintus-text-key-map "q" 'stop-it)
(define-key Quintus-text-key-map "b" 'back-one-step)
(define-key Quintus-text-key-map "u" 'up-one-level)
(define-key Quintus-text-key-map "?" 'get-text-help)
(define-key Quintus-text-key-map "x" 'find-next-reference)
(define-key Quintus-text-key-map "X" 'find-previous-reference)
(define-key Quintus-text-key-map "\C-l" 'redraw-display)
(define-key Quintus-text-key-map "\C-m" 'retrieve-next-reference)
(define-key Quintus-text-key-map "\C-v" 'next-page)
(define-key Quintus-text-key-map "\e\C-v" 'previous-page)
(define-key Quintus-text-key-map "\ez" 'scroll-one-line-up)
(define-key Quintus-text-key-map "\e\C-z" 'scroll-one-line-down)
(define-key Quintus-text-key-map " " 'scroll-up)
(define-key Quintus-text-key-map "\C-?" 'scroll-down)
(define-key Quintus-text-key-map "<" 'beginning-of-buffer)
(define-key Quintus-text-key-map ">" 'end-of-buffer))
(defun Quintus-help-key-map ()
"Define the local key map for The Quintus Prolog Help System."
(define-key Quintus-help-key-map " " 'find-next-entry)
(define-key Quintus-help-key-map "\C-m" 'get-entry)
(define-key Quintus-help-key-map "\C-?" 'find-previous-entry)
(define-key Quintus-help-key-map "q" 'stop-it)
(define-key Quintus-help-key-map "u" 'up-one-level)
(define-key Quintus-help-key-map "b" 'back-one-step)
(define-key Quintus-help-key-map "?" 'get-menu-help)
(define-key Quintus-help-key-map "\C-l" 'redraw-display))
(defun delete-type-marker ()
"Delete the type marker. Function 'delete-type-marker' assumes the
existence of the type marker has been verified with 'file-type'."
(goto-char (point-max))
(forward-line -1)
(kill-line 1)
(goto-char (point-min)))
(defun file-type (type)
"Find the type marker: {menu} or {text}."
(goto-char (point-max))
(forward-line -1)
(beginning-of-line)
(cond ((search-forward type nil NOERROR) (goto-char (point-min)))
(t (not (goto-char (point-min))))))