weiner@novavax.UUCP (Bob &) (07/14/90)
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