home *** CD-ROM | disk | FTP | other *** search
#! /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 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;; Last update: 25 June 1990 by Goran Rydqvist, gorry@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 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 
