mip@massormetrix.ida.liu.se (Mikael Patel) (12/19/89)
#! /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 7)."
# Contents: forth.el
# Wrapped by mip@massormetrix on Mon Dec 18 18:40:13 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f forth.el -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"forth.el\"
else
echo shar: Extracting \"forth.el\" \(26164 characters\)
sed "s/^X//" >forth.el <<'END_OF_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 mip@ida.liu.se Exp $
X
X;;-------------------------------------------------------------------
X;; A Forth indentation, documentation search and interaction library
X;;-------------------------------------------------------------------
X;;
X;; Written by Goran Rydqvist, gorry@ida.liu.se, Summer 1988
X;; Started: 16 July 88
X;; Version: 2.10
X;; Last update: 5 December 1989 by Mikael Patel, mip@ida.liu.se
X;;
X;; Documentation: See forth-mode (^HF forth-mode)
X;;-------------------------------------------------------------------
X
X
X(defvar forth-positives
X " : begin do ?do while if else case create 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 ;; If current buffer is *forth*, don't do anything.
X (if (not (eq (window-buffer) (get-buffer "*forth*")))
X (progn
X (delete-other-windows)
X (split-window-vertically
X (/ (* (screen-height) forth-percent-height) 100))
X (other-window 1)
X (set-window-buffer (selected-window) "*forth*")
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(define-key forth-mode-map "\C-hf" 'forth-documentation)
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(defvar forth-search-command-prefix "grep -n \"^")
X(defvar forth-search-command-suffix "/dev/null")
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 "No load-path specified")))
X
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 (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 (point-max))
X (insert "--------------------\n\n"))
X (let (fd doc (limit (point-max)))
X (while (setq fd (forth-get-file-data limit))
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) (insert "Not found")))
X (select-window curwin)))
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 (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 (if (< (point) limit)
X (progn
X (if (not (= (point) (point-min)))
X (skip-chars-forward "^\n"))
X (if (eq (following-char) ?\n)
X (if (/= (point) (point-max))
X (forward-char 1)))
X (forth-get-file-data-cont limit))))
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
END_OF_forth.el
if test 26164 -ne `wc -c <forth.el`; then
echo shar: \"forth.el\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 5 \(of 7\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 7 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 7 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