Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1590

Internet Message Format | 1990-12-28 | 29KB

From: [e-mail] (Mikael Patel)
Newsgroups: alt.sources
Subject: TILE Forth Release 2.0, package 5 of 6
Message-ID: <[e-mail]>
Date: 16 Jul 90 18:58:40 GMT


#! /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 archive 5 (of 6)."
# Contents:  src/forth.el
# Wrapped by mip@mina on Fri Jun 29 16:49:13 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f src/forth.el -a "${1}" != "-c" ; then
  echo shar: Will not over-write existing file \"src/forth.el\"
else
echo shar: Extracting \"src/forth.el\" \(27117 characters\)
sed "s/^X//" >src/forth.el <<'END_OF_src/forth.el'
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;;; $Header: forth.el,v 2.10 89/12/05 [e-mail] Exp $
X
X;;-------------------------------------------------------------------
X;; A Forth indentation, documentation search and interaction library
X;;-------------------------------------------------------------------
X;;
X;; Written by Goran Rydqvist, [e-mail], Summer 1988
X;; Started:    16 July 88
X;; Version:    2.10
X;; Last update:    5 December 1989 by Mikael Patel, [e-mail]
X;; Last update:    25 June 1990 by Goran Rydqvist, [e-mail]
X;;
X;; Documentation: See forth-mode (^HF forth-mode)
X;;-------------------------------------------------------------------
X
X
X(defvar forth-positives
X  " : begin do ?do while if else case block[ does> exception> struct.type struct.init struct.does accept task.type task.body subclass method enum.type "
X  "Contains all words which will cause the indent-level to be incremented
Xon the next line.
XOBS! All words in forth-positives must be surrounded by spaces.")
X
X(defvar forth-negatives
X  " ; ]; until repeat while +loop loop else then again endcase does> exception> struct.init struct.does struct.end accept.end task.body task.end subclass.end enum.end "
X  "Contains all words which will cause the indent-level to be decremented
Xon the current line.
XOBS! All words in forth-negatives must be surrounded by spaces.")
X
X(defvar forth-zeroes
X  " : ; does> exception> struct.end task.end enum.end"
X  "Contains all words which causes the indent to go to zero")
X
X(defvar forth-mode-abbrev-table nil
X  "Abbrev table in use in Forth-mode buffers.")
X
X(define-abbrev-table 'forth-mode-abbrev-table ())
X
X(defvar forth-mode-map nil
X  "Keymap used in Forth mode.")
X
X(if (not forth-mode-map)
X    (setq forth-mode-map (make-sparse-keymap)))
X
X(global-set-key "\e\C-m" 'forth-send-paragraph)
X(global-set-key "\C-x\C-m" 'forth-split)
X(global-set-key "\e " 'forth-reload)
X
X(define-key forth-mode-map "\e\C-m" 'forth-send-paragraph)
X(define-key forth-mode-map "\eo" 'forth-send-buffer)
X(define-key forth-mode-map "\C-x\C-m" 'forth-split)
X(define-key forth-mode-map "\e " 'forth-reload)
X(define-key forth-mode-map "\t" 'forth-indent-command)
X(define-key forth-mode-map "\C-m" 'reindent-then-newline-and-indent)
X
X(defvar forth-mode-syntax-table nil
X  "Syntax table in use in Forth-mode buffers.")
X
X(if (not forth-mode-syntax-table)
X    (progn
X      (setq forth-mode-syntax-table (make-syntax-table))
X      (modify-syntax-entry ?\\ "\\" forth-mode-syntax-table)
X      (modify-syntax-entry ?/ ". 14" forth-mode-syntax-table)
X      (modify-syntax-entry ?* ". 23" forth-mode-syntax-table)
X      (modify-syntax-entry ?+ "." forth-mode-syntax-table)
X      (modify-syntax-entry ?- "." forth-mode-syntax-table)
X      (modify-syntax-entry ?= "." forth-mode-syntax-table)
X      (modify-syntax-entry ?% "." forth-mode-syntax-table)
X      (modify-syntax-entry ?< "." forth-mode-syntax-table)
X      (modify-syntax-entry ?> "." forth-mode-syntax-table)
X      (modify-syntax-entry ?& "." forth-mode-syntax-table)
X      (modify-syntax-entry ?| "." forth-mode-syntax-table)
X      (modify-syntax-entry ?\' "\"" forth-mode-syntax-table)
X      (modify-syntax-entry ?\t "    " forth-mode-syntax-table)
X      (modify-syntax-entry ?) ">   " forth-mode-syntax-table)
X      (modify-syntax-entry ?( "<   " forth-mode-syntax-table)
X      (modify-syntax-entry ?\( "()  " forth-mode-syntax-table)
X      (modify-syntax-entry ?\) ")(  " forth-mode-syntax-table)))
X
X(defconst forth-indent-level 2
X  "Indentation of Forth statements.")
X
X(defun forth-mode-variables ()
X  (set-syntax-table forth-mode-syntax-table)
X  (setq local-abbrev-table forth-mode-abbrev-table)
X  (make-local-variable 'paragraph-start)
X  (setq paragraph-start (concat "^$\\|" page-delimiter))
X  (make-local-variable 'paragraph-separate)
X  (setq paragraph-separate paragraph-start)
X  (make-local-variable 'indent-line-function)
X  (setq indent-line-function 'forth-indent-line)
X  (make-local-variable 'require-final-newline)
X  (setq require-final-newline t)
X  (make-local-variable 'comment-start)
X  (setq comment-start "( ")
X  (make-local-variable 'comment-end)
X  (setq comment-end " )")
X  (make-local-variable 'comment-column)
X  (setq comment-column 40)
X  (make-local-variable 'comment-start-skip)
X  (setq comment-start-skip "( ")
X  (make-local-variable 'comment-indent-hook)
X  (setq comment-indent-hook 'forth-comment-indent)
X  (make-local-variable 'parse-sexp-ignore-comments)
X  (setq parse-sexp-ignore-comments t))
X
X(defun forth-mode ()
X  "
XMajor mode for editing Forth code. Tab indents for Forth code. Comments
Xare delimited with ( ). Paragraphs are separated by blank lines only.
XDelete converts tabs to spaces as it moves back.
X\\{forth-mode-map}
X Forth-split
X    Positions the current buffer on top and a forth-interaction window
X    below. The window size is controlled by the forth-percent-height
X    variable (see below).
X Forth-reload
X    Reloads the forth library and restarts the forth process.
X Forth-send-buffer
X    Sends the current buffer, in text representation, as input to the
X    forth process.
X Forth-send-paragraph
X    Sends the previous or the current paragraph to the forth-process.
X    Note that the cursor only need to be with in the paragraph to be sent.
Xforth-documentation
X    Search for documentation of forward adjacent to cursor. Note! To use
X    this mode you have to add a line, to your .emacs file, defining the
X    directories to search through for documentation files (se variable
X    forth-help-load-path below) e.g. (setq forth-help-load-path '(nil)).
X
XVariables controlling interaction and startup
X forth-percent-height
X    Tells split how high to make the edit portion, in percent of the
X    current screen height.
X forth-program-name
X    Tells the library which program name to execute in the interation
X    window.
X
XVariables controlling indentation style:
X forth-positives
X    A string containing all words which causes the indent-level of the
X    following line to be incremented.
X    OBS! Each word must be surronded by spaces.
X forth-negatives
X    A string containing all words which causes the indentation of the
X    current line to be decremented, if the word begin the line. These
X    words also has a cancelling effect on the indent-level of the
X    following line, independent of position.
X    OBS! Each word must be surronded by spaces.
X forth-zeroes
X    A string containing all words which causes the indentation of the
X    current line to go to zero, if the word begin the line.
X    OBS! Each word must be surronded by spaces.
X forth-indent-level
X    Indentation increment/decrement of Forth statements.
X
X Note! A word which decrements the indentation of the current line, may
X    also be mentioned in forth-positives to cause the indentation to
X    resume the previous level.
X
XVariables controling documentation search
X forth-help-load-path
X    List of directories to search through to find *.doc
X    (forth-help-file-suffix) files. Nil means current default directory.
X    The specified directories must contain at least one .doc file. If it
X    does not and you still want the load-path to scan that directory, create
X    an empty file dummy.doc.
X forth-help-file-suffix
X    The file names to search for in each directory specified by
X    forth-help-load-path. Defaulted to '*.doc'.
X"
X  (interactive)
X  (kill-all-local-variables)
X  (use-local-map forth-mode-map)
X  (setq mode-name "Forth")
X  (setq major-mode 'forth-mode)
X  (forth-mode-variables)
X  (if (not (forth-process-running-p))
X      (run-forth forth-program-name))
X  (run-hooks 'forth-mode-hook))
X
X(defun forth-comment-indent ()
X  (save-excursion
X    (beginning-of-line)
X    (if (looking-at ":[ \t]*")
X    (progn
X      (end-of-line)
X      (skip-chars-backward " \t\n")
X      (1+ (current-column)))
X      comment-column)))
X
X(defun forth-current-indentation ()
X  (save-excursion
X    (beginning-of-line)
X    (back-to-indentation)
X    (current-column)))
X
X(defun forth-delete-indentation ()
X  (let ((b nil) (m nil))
X    (save-excursion
X      (beginning-of-line)
X      (setq b (point))
X      (back-to-indentation)
X      (setq m (point)))
X    (delete-region b m)))
X
X(defun forth-indent-line (&optional flag)
X  "Correct indentation of the current Forth line."
X  (let ((x (forth-calculate-indent)))
X    (forth-indent-to x)))
X
X(defun forth-indent-command ()
X  (interactive)
X  (forth-indent-line t))
X
X(defun forth-indent-to (x)
X  (let ((p nil))
X    (setq p (- (current-column) (forth-current-indentation)))
X    (forth-delete-indentation)
X    (beginning-of-line)
X    (indent-to x)
X    (if (> p 0) (forward-char p))))
X
X;;Calculate indent
X(defun forth-calculate-indent ()
X  (let ((w1 nil) (indent 0) (centre 0))
X    (save-excursion
X      (beginning-of-line)
X      (skip-chars-backward " \t\n")
X      (beginning-of-line)
X      (back-to-indentation)
X      (setq indent (current-column))
X      (setq centre indent)
X      (setq indent (+ indent (forth-sum-line-indentation))))
X    (save-excursion
X      (beginning-of-line)
X      (back-to-indentation)
X      (let ((p (point)))
X    (skip-chars-forward "^ \t\n")
X    (setq w1 (buffer-substring p (point)))))
X    (if (> (- indent centre) forth-indent-level)
X    (setq indent (+ centre forth-indent-level)))
X    (if (> (- centre indent) forth-indent-level)
X    (setq indent (- centre forth-indent-level)))
X    (if (< indent 0) (setq indent 0))
X    (setq indent (- indent
X            (if (string-match
X             (regexp-quote (concat " " w1 " "))
X             forth-negatives)
X            forth-indent-level 0)))
X    (if (string-match (regexp-quote (concat " " w1 " ")) forth-zeroes)
X    (setq indent 0))
X    indent))
X
X(defun forth-sum-line-indentation ()
X  "Add upp the positive and negative weights of all words on the current line."
X  (let ((b (point)) (e nil) (sum 0) (w nil) (t1 nil) (t2 nil) (first t))
X    (end-of-line) (setq e (point))
X    (goto-char b)
X    (while (< (point) e)
X      (setq w (forth-next-word))
X      (setq t1 (string-match (regexp-quote (concat " " w " "))
X                 forth-positives))
X      (setq t2 (string-match (regexp-quote (concat " " w " "))
X                 forth-negatives))
X      (if (and t1 t2)
X      (setq sum (+ sum forth-indent-level)))
X      (if t1
X      (setq sum (+ sum forth-indent-level)))
X      (if (and t2 (not first))
X      (setq sum (- sum forth-indent-level)))
X      (skip-chars-forward " \t")
X      (setq first nil))
X    sum))
X
X
X(defun forth-next-word ()
X  "Return the next forth-word. Skip anything enclosed in double quotes or ()."
X  (let ((w1 nil))
X    (while (not w1)
X      (skip-chars-forward " \t\n")
X      (let ((p (point)))
X    (skip-chars-forward "^ \t\n")
X    (setq w1 (buffer-substring p (point))))
X      (cond ((string-match "\"" w1)
X         (progn
X           (skip-chars-forward "^\"")
X           (setq w1 nil)))
X        ((string-match "\(" w1)
X         (progn
X           (skip-chars-forward "^\)")
X           (setq w1 nil)))
X        (t nil)))
X    w1))
X
X
X;; Forth commands
X
X(defvar forth-program-name "forth"
X  "*Program invoked by the `run-forth' command.")
X
X(defvar forth-band-name nil
X  "*Band loaded by the `run-forth' command.")
X
X(defvar forth-program-arguments nil
X  "*Arguments passed to the Forth program by the `run-forth' command.")
X
X(defun run-forth (command-line)
X  "Run an inferior Forth process. Output goes to the buffer `*forth*'.
XWith argument, asks for a command line. Split up screen and run forth
Xin the lower portion. The current-buffer when called will stay in the
Xupper portion of the screen, and all other windows are deleted.
XCall run-forth again to make the *forth* buffer appear in the lower
Xpart of the screen."
X  (interactive
X   (list (let ((default
X         (or forth-process-command-line
X             (forth-default-command-line))))
X       (if current-prefix-arg
X           (read-string "Run Forth: " default)
X           default))))
X  (setq forth-process-command-line command-line)
X  (forth-start-process command-line)
X  (forth-split)
X  (forth-set-runlight forth-runlight:input))
X
X(defun reset-forth ()
X  "Reset the Forth process."
X  (interactive)
X  (let ((process (get-process forth-program-name)))
X    (cond ((or (not process)
X           (not (eq (process-status process) 'run))
X           (yes-or-no-p
X"The Forth process is running, are you SURE you want to reset it? "))
X       (message "Resetting Forth process...")
X       (forth-reload)
X       (message "Resetting Forth process...done")))))
X
X(defun forth-default-command-line ()
X  (concat forth-program-name " -emacs"
X      (if forth-program-arguments
X          (concat " " forth-program-arguments)
X          "")
X      (if forth-band-name
X          (concat " -band " forth-band-name)
X          "")))
X
X;;;; Internal Variables
X
X(defvar forth-process-command-line nil
X  "Command used to start the most recent Forth process.")
X
X(defvar forth-previous-send ""
X  "Most recent expression transmitted to the Forth process.")
X
X(defvar forth-process-filter-queue '()
X  "Queue used to synchronize filter actions properly.")
X
X(defvar forth-prompt "ok"
X  "The current forth prompt string.")
X
X(defvar forth-start-hook nil
X  "If non-nil, a procedure to call when the Forth process is started.
XWhen called, the current buffer will be the Forth process-buffer.")
X
X(defvar forth-signal-death-message nil
X  "If non-nil, causes a message to be generated when the Forth process dies.")
X
X(defvar forth-percent-height 62
X  "Tells run-forth how high the upper window should be in percent.")
X
X(defconst forth-runlight:input ?I
X  "The character displayed when the Forth process is waiting for input.")
X
X(defvar forth-mode-string ""
X  "String displayed in the mode line when the Forth process is running.")
X
X;;;; Evaluation Commands
X
X(defun forth-send-string (&rest strings)
X  "Send the string arguments to the Forth process.
XThe strings are concatenated and terminated by a newline."
X  (cond ((forth-process-running-p)
X     (forth-send-string-1 strings))
X    ((yes-or-no-p "The Forth process has died.  Reset it? ")
X     (reset-forth)
X     (goto-char (point-max))
X     (forth-send-string-1 strings))))
X
X(defun forth-send-string-1 (strings)
X  (let ((string (apply 'concat strings)))
X    (forth-send-string-2 string)))
X
X(defun forth-send-string-2 (string)
X  (let ((process (get-process forth-program-name)))
X    (if (not (eq (current-buffer) (get-buffer forth-program-name)))
X    (progn
X     (forth-process-filter-output string)
X     (forth-process-filter:finish)))
X    (send-string process (concat string "\n"))
X    (if (eq (current-buffer) (process-buffer process))
X    (set-marker (process-mark process) (point)))))
X
X
X(defun forth-send-region (start end)
X  "Send the current region to the Forth process.
XThe region is sent terminated by a newline."
X  (interactive "r")
X  (let ((process (get-process forth-program-name)))
X    (if (and process (eq (current-buffer) (process-buffer process)))
X    (progn (goto-char end)
X           (set-marker (process-mark process) end))))
X  (forth-send-string "\n" (buffer-substring start end) "\n"))
X
X(defun forth-end-of-paragraph ()
X  (if (looking-at "[\t\n ]+") (skip-chars-backward  "\t\n "))
X  (if (not (re-search-forward "\n[ \t]*\n" nil t))
X      (goto-char (point-max))))
X
X(defun forth-send-paragraph ()
X  "Send the current or the previous paragraph to the Forth process"
X  (interactive)
X  (let (end)
X    (save-excursion
X      (forth-end-of-paragraph)
X      (skip-chars-backward  "\t\n ")
X      (setq end (point))
X      (if (re-search-backward "\n[ \t]*\n" nil t)
X      (setq start (point))
X    (goto-char (point-min)))
X      (skip-chars-forward  "\t\n ")
X      (forth-send-region (point) end))))
X
X(defun forth-send-buffer ()
X  "Send the current buffer to the Forth process."
X  (interactive)
X  (if (eq (current-buffer) (forth-process-buffer))
X      (error "Not allowed to send this buffer's contents to Forth"))
X  (forth-send-region (point-min) (point-max)))
X
X
X;;;; Basic Process Control
X
X(defun forth-start-process (command-line)
X  (let ((buffer (get-buffer-create "*forth*")))
X    (let ((process (get-buffer-process buffer)))
X      (save-excursion
X    (set-buffer buffer)
X    (progn (if process (delete-process process))
X           (goto-char (point-max))
X           (setq mode-line-process '(": %s"))
X           (add-to-global-mode-string 'forth-mode-string)
X           (setq process
X             (apply 'start-process
X                (cons forth-program-name
X                  (cons buffer
X                    (forth-parse-command-line
X                     command-line)))))
X           (set-marker (process-mark process) (point-max))
X           (forth-process-filter-initialize t)
X           (forth-modeline-initialize)
X           (set-process-sentinel process 'forth-process-sentinel)
X           (set-process-filter process 'forth-process-filter)
X           (run-hooks 'forth-start-hook)))
X    buffer)))
X
X(defun forth-parse-command-line (string)
X  (setq string (substitute-in-file-name string))
X  (let ((start 0)
X    (result '()))
X    (while start
X      (let ((index (string-match "[ \t]" string start)))
X    (setq start
X          (cond ((not index)
X             (setq result
X               (cons (substring string start)
X                 result))
X             nil)
X            ((= index start)
X             (string-match "[^ \t]" string start))
X            (t
X             (setq result
X               (cons (substring string start index)
X                 result))
X             (1+ index))))))
X    (nreverse result)))
X
X
X(defun forth-process-running-p ()
X  "True iff there is a Forth process whose status is `run'."
X  (let ((process (get-process forth-program-name)))
X    (and process
X     (eq (process-status process) 'run))))
X
X(defun forth-process-buffer ()
X  (let ((process (get-process forth-program-name)))
X    (and process (process-buffer process))))
X
X;;;; Process Filter
X
X(defun forth-process-sentinel (proc reason)
X  (let ((inhibit-quit nil))
X    (forth-process-filter-initialize (eq reason 'run))
X    (if (eq reason 'run)
X    (forth-modeline-initialize)
X    (setq forth-mode-string "")))
X  (if (and (not (memq reason '(run stop)))
X       forth-signal-death-message)
X      (progn (beep)
X         (message
X"The Forth process has died!  Do M-x reset-forth to restart it"))))
X
X(defun forth-process-filter-initialize (running-p)
X  (setq forth-process-filter-queue (cons '() '()))
X  (setq forth-prompt "ok"))
X
X
X(defun forth-process-filter (proc string)
X  (forth-process-filter-output string)
X  (forth-process-filter:finish))
X
X(defun forth-process-filter:enqueue (action)
X  (let ((next (cons action '())))
X    (if (cdr forth-process-filter-queue)
X    (setcdr (cdr forth-process-filter-queue) next)
X    (setcar forth-process-filter-queue next))
X    (setcdr forth-process-filter-queue next)))
X
X(defun forth-process-filter:finish ()
X  (while (car forth-process-filter-queue)
X    (let ((next (car forth-process-filter-queue)))
X      (setcar forth-process-filter-queue (cdr next))
X      (if (not (cdr next))
X      (setcdr forth-process-filter-queue '()))
X      (apply (car (car next)) (cdr (car next))))))
X
X;;;; Process Filter Output
X
X(defun forth-process-filter-output (&rest args)
X  (if (not (and args
X        (null (cdr args))
X        (stringp (car args))
X        (string-equal "" (car args))))
X      (forth-process-filter:enqueue
X       (cons 'forth-process-filter-output-1 args))))
X
X(defun forth-process-filter-output-1 (&rest args)
X  (save-excursion
X    (forth-goto-output-point)
X    (apply 'insert-before-markers args)))
X
X(defun forth-guarantee-newlines (n)
X  (save-excursion
X    (forth-goto-output-point)
X    (let ((stop nil))
X      (while (and (not stop)
X          (bolp))
X    (setq n (1- n))
X    (if (bobp)
X        (setq stop t)
X      (backward-char))))
X    (forth-goto-output-point)
X    (while (> n 0)
X      (insert-before-markers ?\n)
X      (setq n (1- n)))))
X
X(defun forth-goto-output-point ()
X  (let ((process (get-process forth-program-name)))
X    (set-buffer (process-buffer process))
X    (goto-char (process-mark process))))
X
X(defun forth-modeline-initialize ()
X  (setq forth-mode-string "  "))
X
X(defun forth-set-runlight (runlight)
X  (aset forth-mode-string 0 runlight)
X  (forth-modeline-redisplay))
X
X(defun forth-modeline-redisplay ()
X  (save-excursion (set-buffer (other-buffer)))
X  (set-buffer-modified-p (buffer-modified-p))
X  (sit-for 0))
X
X;;;; Process Filter Operations
X
X(defun add-to-global-mode-string (x)
X  (cond ((null global-mode-string)
X     (setq global-mode-string (list "" x " ")))
X    ((not (memq x global-mode-string))
X     (setq global-mode-string
X           (cons ""
X             (cons x
X               (cons " "
X                 (if (equal "" (car global-mode-string))
X                     (cdr global-mode-string)
X                     global-mode-string))))))))
X
X
X;; Misc
X
X(setq auto-mode-alist (append auto-mode-alist
X                '(("\\.f83$" . forth-mode))))
X
X(defun forth-split ()
X  (interactive)
X  (forth-split-1 "*forth*"))
X
X(defun forth-split-1 (buffer)
X  (if (not (eq (window-buffer) (get-buffer buffer)))
X      (progn
X    (delete-other-windows)
X    (split-window-vertically
X     (/ (* (screen-height) forth-percent-height) 100))
X    (other-window 1)
X    (switch-to-buffer buffer)
X    (goto-char (point-max))
X    (other-window 1))))
X
X(defun forth-reload ()
X  (interactive)
X  (let ((process (get-process forth-program-name)))
X    (if process (kill-process process t)))
X  (sleep-for-millisecs 100)
X  (forth-mode))
X
X
X;; Special section for forth-help
X
X(defvar forth-help-buffer "*Forth-help*"
X  "Buffer used to display the requested documentation.")
X
X(defvar forth-help-load-path nil
X  "List of directories to search through to find *.doc
X (forth-help-file-suffix) files. Nil means current default directory.
X The specified directories must contain at least one .doc file. If it
X does not and you still want the load-path to scan that directory, create
X an empty file dummy.doc.")
X
X(defvar forth-help-file-suffix "*.doc"
X  "The file names to search for in each directory.")
X
X(setq forth-search-command-prefix "grep -n \"^    [^(]* ")
X(defvar forth-search-command-suffix "/dev/null")
X(defvar forth-grep-error-regexp ": No such file or directory")
X
X(defun forth-function-called-at-point ()
X  "Return the space delimited word a point."
X  (save-excursion
X    (save-restriction
X      (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
X      (skip-chars-backward "^ \t\n" (point-min))
X      (if (looking-at "[ \t\n]")
X      (forward-char 1))
X      (let (obj (p (point)))
X    (skip-chars-forward "^ \t\n")
X    (buffer-substring p (point))))))
X
X(defun forth-help-names-extend-comp (path-list result)
X  (cond ((null path-list) result)
X    ((null (car path-list))
X     (forth-help-names-extend-comp (cdr path-list)
X           (concat result forth-help-file-suffix " ")))
X    (t (forth-help-names-extend-comp
X        (cdr path-list) (concat result
X                    (expand-file-name (car path-list)) "/"
X                    forth-help-file-suffix " ")))))
X
X(defun forth-help-names-extended ()
X  (if forth-help-load-path
X      (forth-help-names-extend-comp forth-help-load-path "")
X    (error "forth-help-load-path not specified")))
X
X
X(define-key forth-mode-map "\C-hf" 'forth-documentation)
X
X(defun forth-documentation (function)
X  "Display the full documentation of FORTH word."
X  (interactive
X   (let ((fn (forth-function-called-at-point))
X     (enable-recursive-minibuffers t)
X     search-list
X     val)
X     (setq val (read-string (format "Describe forth word (default %s): " fn)))
X     (list (if (equal val "") fn val))))
X  (forth-get-doc (concat forth-search-command-prefix
X             (grep-regexp-quote (concat function " ("))
X             "[^)]*\-\-\" " (forth-help-names-extended)
X             forth-search-command-suffix))
X  (message "C-x C-m switches back to the forth interaction window"))
X
X(defun forth-get-doc (command)
X  "Display the full documentation of command."
X  (let ((curwin (get-buffer-window (window-buffer)))
X    reswin
X    pointmax)
X    (with-output-to-temp-buffer forth-help-buffer
X      (progn
X    (call-process "sh" nil forth-help-buffer t "-c" command)
X    (setq reswin (get-buffer-window forth-help-buffer))))
X    (setq reswin (get-buffer-window forth-help-buffer))
X    (select-window reswin)
X    (save-excursion
X      (goto-char (setq pointmax (point-max)))
X      (insert "--------------------\n\n"))
X    (let (fd doc)
X      (while (setq fd (forth-get-file-data pointmax))
X    (setq doc (forth-get-doc-string fd))
X    (save-excursion
X      (goto-char (point-max))
X      (insert (substring (car fd) (string-match "[^/]*$" (car fd)))
X          ":\n\n" doc "\n")))
X      (if (not doc)
X      (progn (goto-char (point-max)) (insert "Not found"))))
X    (select-window curwin)))
X
X(defun forth-skip-error-lines ()
X  (let ((lines 0))
X    (save-excursion
X      (while (re-search-forward forth-grep-error-regexp nil t)
X    (beginning-of-line)
X    (forward-line 1)
X    (setq lines (1+ lines))))
X    (forward-line lines)))
X
X(defun forth-get-doc-string (fd)
X  "Find file (car fd) and extract documentation from line (nth 1 fd)."
X  (let (result)
X    (save-window-excursion
X      (find-file (car fd))
X      (goto-line (nth 1 fd))
X      (if (not (eq (nth 1 fd) (1+ (count-lines (point-min) (point)))))
X      (error "forth-get-doc-string: serious error"))
X      (if (not (re-search-backward "\n[\t ]*\n" nil t))
X      (goto-char (point-min))
X    (goto-char (match-end 0)))
X      (let ((p (point)))
X    (if (not (re-search-forward "\n[\t ]*\n" nil t))
X        (goto-char (point-max)))
X    (setq result (buffer-substring p (point))))
X      (bury-buffer (current-buffer)))
X    result))
X
X(defun forth-get-file-data (limit)
X  "Parse grep output and return '(filename line#) list. Return nil when
X passing limit."
X  (forth-skip-error-lines)
X  (if (< (point) limit)
X      (let ((result (forth-get-file-data-cont limit)))
X    (forward-line 1)
X    (beginning-of-line)
X    result)))
X
X(defun forth-get-file-data-cont (limit)
X  (let (result)
X    (let ((p (point)))
X      (skip-chars-forward "^:")
X      (setq result (buffer-substring p (point))))
X    (if (< (point) limit)
X    (let ((p (1+ (point))))
X      (forward-char 1)
X      (skip-chars-forward "^:")
X      (list result (string-to-int (buffer-substring p (point))))))))
X
X(defun grep-regexp-quote (str)
X  (let ((i 0) (m 1) (res ""))
X    (while (/= m 0)
X      (setq m (string-to-char (substring str i)))
X      (if (/= m 0)
X      (progn
X        (setq i (1+ i))
X        (if (string-match (regexp-quote (char-to-string m))
X                  ".*\\^$[]")
X        (setq res (concat res "\\")))
X        (setq res (concat res (char-to-string m))))))
X    res))
X
X
X(define-key forth-mode-map "\C-x\C-e" 'forth-compile)
X(define-key forth-mode-map "\C-x\C-n" 'next-error)
X(require 'compile "compile")
X
X(defvar forth-compile-command "forth ")
X(defvar forth-compilation-window-percent-height 30)
X
X(defun forth-compile (command)
X  (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command))))
X  (forth-split-1 "*compilation*")
X  (setq ctools-compile-command command)
X  (compile1 ctools-compile-command "No more errors"))
X
X
END_OF_src/forth.el
if test 27117 -ne `wc -c <src/forth.el`; then
    echo shar: \"src/forth.el\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 5 \(of 6\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 6 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0