Path: utzoo!utgpu!news-server.csri.toronto.edu!mailrus!uflorida!novavax!weiner
From: weiner@novavax.UUCP (Bob &)
Newsgroups: comp.sys.apollo
Subject: Miscellaneous apollo-specific code for GNU Emacs
Message-ID: <WEINER.90Jul14002404@novavax.UUCP>
Date: 14 Jul 90 04:24:04 GMT
Sender: weiner@novavax.UUCP
Organization: Motorola Inc.
Lines: 454

For those who like to do real editing on Apollos and use GNU Emacs here
are some utilities.

Finally, an apropos mode for Apollo-specific commands, apollo-apropos.el.
How many years has Apollo neglected to provide such a basic thing?

apollo-err.el parses Apollo native compiler errors which of course are
not UNIX compatible.

apoo-rect.el uses Zubkoff's excellent code for GNU Emacs on Apollos and
sets up your mouse keys to do cut copy and paste between the DM and
Emacs

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  apollo-apropos.el apollo-err.el apollo-rect.el
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'apollo-apropos.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'apollo-apropos.el'\"
else
echo shar: Extracting \"'apollo-apropos.el'\" \(5063 characters\)
sed "s/^X//" >'apollo-apropos.el' <<'END_OF_FILE'
X;;!emacs
X;;
X;; FILE:         apollo-apropos.el
X;; SUMMARY:      Apropos and help page display for Aegis and DM commands.
X;; USAGE:        GNU Emacs Lisp Library
X;;
X;; AUTHOR:       Bob Weiner
X;; ORG:          Motorola, Inc.
X;;
X;; ORIG-DATE:     8-Mar-90 at 04:12:12
X;; LAST-MOD:     13-Jul-90 at 23:54:32 by Bob Weiner
X;;
X;; Copyright (C) 1989 Bob Weiner and Free Software Foundation, Inc.
X;; Available for use and distribution under the same terms as GNU Emacs.
X;;
X;; This file is not part of GNU Emacs.
X;;
X;; DESCRIPTION:  
X;;
X;; TO USE:
X;;   {C-h A}  or  {M-x apollo-apropos}
X;;
X;; prompts for keywords, and displays Aegis and DM commands whose summaries
X;; have a word match.  Move cursor to desired command and hit RETURN to
X;; select each command summary for display.
X;;
X;; Based upon 'unix-apropos.el' by Henry Kautz
X;;
X;; To produce the apropos file used by this library,
X;; (value of 'apollo-apropos-whatis-file-name' below), use the following
X;; C-Shell script:
X;;
X;; #!/bin/csh -f
X;;
X;; pushd /sys/help
X;; mv -f /usr/local/ap-whatis /usr/local/ap-whatis.old
X;; foreach f (`ls *.hlp`)
X;;    head -2 $f | tail -1 >> /usr/local/ap-whatis
X;; end
X;; popd
X;;
X;;
X;; Then just clean up the file.
X;;
X;; DESCRIP-END.
X
X
X(global-set-key "\C-hA" 'apollo-apropos)
X
X(defvar *apollo-apropos-window-config* nil
X  "Stores window configuration upon entry of 'apollo-apropos' mode.  Used to
Xrestore window configuration when user quits out of this mode.")
X
X(defvar apollo-apropos-whatis-file-name "/usr/local/ap-whatis")
X
X(defun apollo-apropos-get-man ()
X   "Get the Apollo help entry for the current line"
X   (interactive)
X   (let (topic)
X      (interactive)
X      (beginning-of-line 1)
X      (looking-at "[_A-Za-z0-9]+")
X      (setq topic (buffer-substring (match-beginning 0) (match-end 0)))
X      (apollo-help (downcase topic))
X      (setq mode-line-buffer-identification
X	    (concat "Apollo-Apropos: " topic))
X      )
X   )
X
X(defun apollo-apropos-expunge ()
X   "Kill all the Apollo apropos buffers."
X   (interactive)
X   (mapcar (function (lambda (b)
X			(if (string-match "^\\*Help " (buffer-name b))
X			   (kill-buffer b))))
X      (buffer-list))
X   (if *apollo-apropos-window-config*
X       (progn
X	 (set-window-configuration *apollo-apropos-window-config*)
X	 (setq *apollo-apropos-window-config* nil))))
X
X(defun apollo-apropos-current-word ()
X   "Word cursor is over as a string."
X   (save-excursion
X      (let (beg end)
X	 (re-search-backward "[_A-Za-z0-9]*" nil 2)
X	 (re-search-backward "\\b" nil 2)
X	 (setq beg (point))
X	 (re-search-forward "[_A-Za-z0-9]*\\b" nil 2)
X	 (setq end (point))
X	 (buffer-substring beg end))))
X
X(defun apollo-apropos (topic)
X   "Display apropos for TOPIC"
X   (interactive (list
X		  (downcase (read-string (concat "Apollo apropos ("
X						 (apollo-apropos-current-word) "): ")))))
X   (if (equal "" topic) (setq topic (downcase (apollo-apropos-current-word))))
X   (setq *apollo-apropos-window-config* (current-window-configuration))
X   (pop-to-buffer "*Help Apropos*")
X   (apollo-apropos-mode))
X
X(defun apollo-apropos-additional (additional)
X   (interactive (list
X		  (downcase (read-string (concat "Additional keyword ("
X						 (apollo-apropos-current-word) "): ")))))
X   (if (equal "" additional) (setq additional (downcase (apollo-apropos-current-word))))
X   (goto-char (point-min))
X   (setq buffer-read-only nil)
X   (delete-non-matching-lines (concat "\\b" (regexp-quote additional) "\\b"))
X   (setq buffer-read-only t))
X
X(defvar apollo-apropos-map nil
X  "Keymap containing unix manual apropos commands.")
X(if apollo-apropos-map
X    nil
X  (setq apollo-apropos-map (make-sparse-keymap))
X  (define-key apollo-apropos-map "\C-m" 'apollo-apropos-get-man)
X  (define-key apollo-apropos-map "n" 'next-line)
X  (define-key apollo-apropos-map " " 'scroll-other-window)
X  (define-key apollo-apropos-map "\C-?"
X    (function (lambda nil
X		(interactive)
X		(scroll-other-window '-))))
X  (define-key apollo-apropos-map "p" 'previous-line)
X  (define-key apollo-apropos-map "A" 'apollo-apropos)
X  (define-key apollo-apropos-map "x" 'apollo-apropos-expunge)
X  (define-key apollo-apropos-map "q" 'apollo-apropos-expunge)
X  (define-key apollo-apropos-map "a" 'apollo-apropos-additional)
X  (define-key apollo-apropos-map "h" 'describe-mode)
X  (define-key apollo-apropos-map "?" 'describe-mode)
X  )
X
X(defun apollo-apropos-mode ()
X  "<return> get manual entry; n = next line; p = previous line
Xx,q = expunge man page buffers, quit mode; A = unix apropos;
Xh = describe mode; a = constrain search by an additional keyword
X<space> scroll other window; <delete> reverse scroll other window"
X  (setq buffer-read-only nil)
X  (erase-buffer)
X  (buffer-flush-undo (current-buffer))
X  (use-local-map apollo-apropos-map)
X  (setq mode-name "Apollo Apropos")
X  (setq major-mode 'apollo-apropos-mode)
X  (insert-file apollo-apropos-whatis-file-name)
X  (goto-char (point-min))
X  (delete-non-matching-lines
X    (concat "\\b" (regexp-quote topic) "\\b"))
X  (setq buffer-read-only t)
X  (goto-char (point-min))
X  (run-hooks 'apollo-apropos-mode-hook))
X
X(provide 'apollo-apropos)
END_OF_FILE
if test 5063 -ne `wc -c <'apollo-apropos.el'`; then
    echo shar: \"'apollo-apropos.el'\" unpacked with wrong size!
fi
# end of 'apollo-apropos.el'
fi
if test -f 'apollo-err.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'apollo-err.el'\"
else
echo shar: Extracting \"'apollo-err.el'\" \(5035 characters\)
sed "s/^X//" >'apollo-err.el' <<'END_OF_FILE'
X;;!emacs
X;;
X;; FILE:         apollo-err.el
X;; SUMMARY:      Parses silly Apollo native language error msgs, used by 'next-error'.
X;; USAGE:        GNU Emacs Lisp Library
X;;
X;; AUTHOR:       Bob Weiner
X;; ORG:          Motorola, Inc.
X;;
X;; ORIG-DATE:     8-Aug-89 at 14:57:05
X;; LAST-MOD:     13-Jul-90 at 23:58:00 by Bob Weiner
X;;
X;; Copyright (C) 1989, 1990  Bob Weiner and Free Software Foundation, Inc.
X;; Available for use and distribution under the same terms as GNU Emacs.
X;;
X;; This file is not part of GNU Emacs.
X;;
X;; DESCRIPTION:  
X;;
X;;   Parses silly Apollo native language error format such as:
X;;
X;;     **** Error #121 on Line 3: unrecognizable statement
X;;   or
X;;     ******** Line 24: [Error #116]  Improper expression; "if" found.
X;;
X;;
X;;   Load this library and then invoke error parsing via {C-x `}.
X;;
X;;   Only handles compilation lines of the following form:
X;;
X;;      <compiler> <filename> [<option> ... <option>]
X;;
X;; DESCRIP-END.
X
X(global-set-key "\C-x`" 'next-apollo-error)
X
X(setq compilation-error-regexp "\*\*\*\*.*Line \\([0-9]+\\):.*")
X
X(defun next-apollo-error (&optional argp)
X  "Visit next compilation error message and corresponding source code.
XThis operates on the output from the \\[compile] command.
XIf all preparsed error messages have been processed,
Xthe error message buffer is checked for new ones.
XA non-nil argument (prefix arg, if interactive)
Xmeans reparse the error message buffer and start at the first error."
X  (interactive "P")
X  (if (or (eq compilation-error-list t)
X	  argp)
X      (progn (compilation-forget-errors)
X	     (setq compilation-parsing-end 1)))
X  (if compilation-error-list
X      nil
X    (save-excursion
X      (switch-to-buffer "*compilation*")
X      (set-buffer-modified-p nil)
X      (compilation-parse-apollo-errors)))
X  (let ((next-error (car compilation-error-list)))
X    (if (null next-error)
X	(error (concat compilation-error-message
X		       (if (and compilation-process
X				(eq (process-status compilation-process)
X				    'run))
X			   " yet" ""))))
X    (setq compilation-error-list (cdr compilation-error-list))
X    (if (null (car (cdr next-error)))
X	nil
X      (switch-to-buffer (marker-buffer (car (cdr next-error))))
X      (goto-char (car (cdr next-error)))
X      (set-marker (car (cdr next-error)) nil))
X    (let* ((pop-up-windows t)
X	   (w (display-buffer (marker-buffer (car next-error)))))
X      (set-window-point w (car next-error))
X      (set-window-start w (car next-error)))
X    (set-marker (car next-error) nil)))
X
X(defun compilation-apollo-ftn-grab-filename ()
X  "Return a string which is a filename from the compilation command or nil.
XIgnore quotes around it."
X  ;; First arg of compile cmd should be filename
X  (if (and (string-match "^[^ \t]+[ \t]+\"?\\([^ \t\"]+\\)" compile-command)
X      (match-beginning 1))
X      (substring compile-command (match-beginning 1) (match-end 1))))
X
X(defun compilation-parse-apollo-errors ()
X  "Parse the current buffer as error messages.
XThis makes a list of error descriptors, compilation-error-list.  For each
Xerror line-number in the buffer, the source file is read in, and the text
Xlocation is saved in compilation-error-list.  The function next-error,
Xassigned to \\[next-error], takes the next error off the list and visits its
Xlocation."
X  (setq compilation-error-list nil)
X  (message "Parsing error messages...")
X  (let (text-buffer
X	last-filename last-linenum)
X    ;; Don't reparse messages already seen at last parse.
X    (goto-char compilation-parsing-end)
X    ;; Don't parse the first two lines as error messages.
X    ;; This matters for grep.
X    (if (bobp)
X	(forward-line 2))
X    (let (case-fold-search linenum filename error-marker text-marker)
X      ;; Extract file name
X      (setq filename (compilation-apollo-ftn-grab-filename))
X      (while (re-search-forward compilation-error-regexp nil t)
X	;; Extract line number from error message.
X	(setq linenum (string-to-int (buffer-substring
X				       (match-beginning 1)
X				       (match-end 1))))
X	;; Locate the erring file and line.
X	(if (and (equal filename last-filename)
X		 (= linenum last-linenum))
X	    nil
X	  (beginning-of-line 1)
X	  (setq error-marker (point-marker))
X	  ;; text-buffer gets the buffer containing this error's file.
X