--- gforth/gforth.el 2001/05/18 15:27:21 1.50 +++ gforth/gforth.el 2010/07/04 10:08:40 1.78 @@ -1,6 +1,6 @@ ;;; gforth.el --- major mode for editing (G)Forth sources -;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,2000,2001,2003,2004,2007,2008 Free Software Foundation, Inc. ;; This file is part of Gforth. @@ -33,6 +33,9 @@ ;; Changes by David ;; Added a syntax-hilighting engine, rewrote auto-indentation engine. ;; Added support for block files. +;; Replaced forth-process code with comint-based implementation. + +;; Tested with Emacs 19.34, 20.5, 21 and XEmacs 21 ;;------------------------------------------------------------------- ;; A Forth indentation, documentation search and interaction library @@ -49,17 +52,153 @@ ;;; Code: - +;(setq debug-on-error t) + +;; Code ripped from `version.el' for compatability with Emacs versions +;; prior to 19.23. +(if (not (boundp 'emacs-major-version)) + (defconst emacs-major-version + (progn (string-match "^[0-9]+" emacs-version) + (string-to-number (match-string 0 emacs-version))))) + +;; Code ripped from `subr.el' for compatability with Emacs versions +;; prior to 20.1 +(eval-when-compile +(defun forth-emacs-older (major minor) + (or (< emacs-major-version major) + (and (= emacs-major-version major) (< emacs-minor-version minor)))) + + (if (forth-emacs-older 20 1) + (progn + (defmacro when (cond &rest body) + "If COND yields non-nil, do BODY, else return nil." + (list 'if cond (cons 'progn body))) + (defmacro unless (cond &rest body) + "If COND yields nil, do BODY, else return nil." + (cons 'if (cons cond (cons nil body))))))) + +;; `no-error' argument of require not supported in Emacs versions +;; prior to 20.4 :-( +(eval-and-compile +(defun forth-require (feature) + (condition-case err (require feature) (error nil)))) + +(require 'font-lock) + +;; define `font-lock-warning-face' in emacs-versions prior to 20.1 +;; (ripped from `font-lock.el') +(unless (boundp 'font-lock-warning-face) + (message "defining font-lock-warning-face") + (make-face 'font-lock-warning-face) + (defvar font-lock-warning-face 'font-lock-warning-face) + (set-face-foreground font-lock-warning-face "red") + (make-face-bold font-lock-warning-face)) + +;; define `font-lock-constant-face' in XEmacs (just copy +;; `font-lock-preprocessor-face') +(unless (boundp 'font-lock-constant-face) + (copy-face font-lock-preprocessor-face 'font-lock-constant-face)) + + +;; define `regexp-opt' in emacs versions prior to 20.1 +;; (this implementation is extremely inefficient, though) +(eval-and-compile (forth-require 'regexp-opt)) +(unless (memq 'regexp-opt features) + (message (concat + "Warning: your Emacs version doesn't support `regexp-opt'. " + "Hilighting will be slow.")) + (defun regexp-opt (STRINGS &optional PAREN) + (let ((open (if PAREN "\\(" "")) (close (if PAREN "\\)" ""))) + (concat open (mapconcat 'regexp-quote STRINGS "\\|") close))) + (defun regexp-opt-depth (re) + (if (string= (substring re 0 2) "\\(") 1 0))) -;;; Hilighting and indentation engine (dk) +; todo: +; + +; screen-height existiert nicht in XEmacs, frame-height ersetzen? +; + +; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF +; -- mit aktueller Konzeption nicht möglich?? +; +; Konfiguration über customization groups +; +; Bereich nur auf Wortanfang/ende ausweiten, wenn Anfang bzw Ende in einem +; Wort liegen (?) -- speed! +; +; 'forth-word' property muss eindeutig sein! +; +; Forth-Menu +; +; Interface zu GForth Prozessen (Patches von Michael Scholz) +; +; Byte-compile-Code rausschmeißen, Compilieren im Makefile über Emacs +; batch-Modus +; +; forth-help Kram rausschmeißen +; +; XEmacs Kompatibilität? imenu/speedbar -> fume? +; +; Folding neuschreiben (neue Parser-Informationen benutzen) + +;;; Motion-hooking (dk) +;;; +(defun forth-idle-function () + "Function that is called when Emacs is idle to detect cursor motion +in forth-block-mode buffers (which is mainly used for screen number +display in). Currently ignores forth-mode buffers but that may change +in the future." + (if (eq major-mode 'forth-block-mode) + (forth-check-motion))) + +(defvar forth-idle-function-timer nil + "Timer that runs `forth-idle-function' or nil if no timer installed.") + +(defun forth-install-motion-hook () + "Install the motion-hooking mechanism. Currently uses idle timers +but might be transparently changed in the future." + (unless forth-idle-function-timer + ;; install idle function only once (first time forth-mode is used) + (setq forth-idle-function-timer + (run-with-idle-timer .05 t 'forth-idle-function)))) + +(defvar forth-was-point nil) + +(defun forth-check-motion () + "Run `forth-motion-hooks', if `point' changed since last call. This +used to be called via `post-command-hook' but uses idle timers now as +users complaint about lagging performance." + (when (or (eq forth-was-point nil) (/= forth-was-point (point))) + (setq forth-was-point (point)) + (run-hooks 'forth-motion-hooks))) + + +;;; Hilighting and indentation engine (dk) ;;; +(defvar forth-disable-parser nil + "*Non-nil means to disable on-the-fly parsing of Forth-code. + +This will disable hilighting of forth-mode buffers and will decrease +the smartness of the indentation engine. Only set it to non-nil, if +your computer is very slow. To disable hilighting, set +`forth-hilight-level' to zero.") + +(defvar forth-jit-parser nil + "*Non-nil means to parse Forth-code just-in-time. + +This eliminates the need for initially parsing forth-mode buffers and +thus speeds up loading of Forth files. That feature is only available +in Emacs21 (and newer versions).") (defvar forth-words nil "List of words for hilighting and recognition of parsed text areas. -You can enable hilighting of object-oriented Forth code, by appending either -`forth-objects-words' or `forth-oof-words' to the list, depending on which -OOP package you're using. After `forth-words' changed, `forth-compile-words' -must be called to make the changes take effect. + +Hilighting of object-oriented Forth code is achieved, by appending either +`forth-objects-words' or `forth-oof-words' to the list, depending on the values of `forth-use-objects' or `forth-use-oof'. + +After `forth-words' changed, `forth-compile-words' must be called to +make the changes take effect. Each item of `forth-words' has the form (MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...) @@ -108,6 +247,11 @@ PARSED-TYPE specifies what kind of text "[\n\t ]" t string (font-lock-string-face . 1)) (("included" "required" "thru" "load") non-immediate (font-lock-keyword-face . 1)) + (("code" "abi-code") + non-immediate (font-lock-keyword-face . 1) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("end-code") + non-immediate (font-lock-keyword-face . 1)) (("[char]") compile-only (font-lock-keyword-face . 1) "[ \t\n]" t string (font-lock-string-face . 1)) (("char") non-immediate (font-lock-keyword-face . 1) @@ -132,22 +276,26 @@ PARSED-TYPE specifies what kind of text (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for" - "case" "of" "?dup-if" "?dup-0=-if" "then" "until" "repeat" "again" + "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until" + "repeat" "again" "leave" "?leave" "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try" - "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2(" + "recover" "endtry" "iferror" "restore" "endtry-iferror" + "assert(" "assert0(" "assert1(" "assert2(" "assert3(" ")" "" "compilation>") compile-only (font-lock-keyword-face . 2)) (("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w") non-immediate (font-lock-constant-face . 2)) - (("~~") compile-only (font-lock-warning-face . 2)) + (("~~" "break:" "dbg") compile-only (font-lock-warning-face . 2)) + (("break\"") compile-only (font-lock-warning-face . 1) + "[\"\n]" nil string (font-lock-string-face . 1)) (("postpone" "[is]" "defers" "[']" "[compile]") compile-only (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("is" "what's") immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("" "'") non-immediate (font-lock-keyword-face . 2) + (("" "'" "see") non-immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("[to]") compile-only (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-variable-name-face . 3)) @@ -161,6 +309,7 @@ PARSED-TYPE specifies what kind of text "create-interpret/compile") non-immediate (font-lock-type-face . 2) "[ \t\n]" t name (font-lock-variable-name-face . 3)) + ("\\S-+%" non-immediate (font-lock-type-face . 2)) (("defer" "alias" "create-interpret/compile:") non-immediate (font-lock-type-face . 1) "[ \t\n]" t name (font-lock-function-name-face . 3)) @@ -169,100 +318,163 @@ PARSED-TYPE specifies what kind of text (("struct") non-immediate (font-lock-keyword-face . 2)) ("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)" immediate (font-lock-constant-face . 3)) + ("-?\\([&#][0-9]+\\|\\(0x\\|\\$\\)[0-9a-f]+\\|%[01]+\\)" + immediate (font-lock-constant-face . 3)) )) -(defvar forth-objects-words nil - "Hilighting description for words of the \"Objects\" OOP package") -(setq forth-objects-words - '(((":m") definition-starter (font-lock-keyword-face . 1) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("m:") definition-starter (font-lock-keyword-face . 1)) - ((";m") definition-ender (font-lock-keyword-face . 1)) - (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("current" "overrides") non-immediate (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("[to-inst]") compile-only (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-variable-name-face . 3)) - (("[bind]") compile-only (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-type-face . 3) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("bind") non-immediate (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-type-face . 3) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2) - "[ \t\n]" t name (font-lock-variable-name-face . 3)) - (("method" "selector") - non-immediate (font-lock-type-face . 1) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("end-class" "end-interface") - non-immediate (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-type-face . 3)) - (("public" "protected" "class" "exitm" "implementation" "interface" - "methods" "end-methods" "this") - non-immediate (font-lock-keyword-face . 2)) - (("object") non-immediate (font-lock-type-face . 2)))) -; (nconc forth-words forth-objects-words) - -(defvar forth-oof-words nil - "Hilighting description for words of the \"OOF\" OOP package") -(setq forth-oof-words - '((("class") non-immediate (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-type-face . 3)) - (("var") non-immediate (font-lock-type-face . 2) - "[ \t\n]" t name (font-lock-variable-name-face . 3)) - (("method") non-immediate (font-lock-type-face . 2) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("::" "super" "bind" "bound" "link") - immediate (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("ptr" "asptr" "[]") - immediate (font-lock-keyword-face . 2) - "[ \t\n]" t name (font-lock-variable-name-face . 3)) - (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with" - "endwith") - non-immediate (font-lock-keyword-face . 2)) - (("object") non-immediate (font-lock-type-face . 2)))) -; (nconc forth-words forth-oof-words) +(defvar forth-use-objects nil + "*Non-nil makes forth-mode also hilight words from the \"Objects\" package.") +(defvar forth-objects-words + '(((":m") definition-starter (font-lock-keyword-face . 1) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("m:") definition-starter (font-lock-keyword-face . 1)) + ((";m") definition-ender (font-lock-keyword-face . 1)) + (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("current" "overrides") non-immediate (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("[to-inst]") compile-only (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-variable-name-face . 3)) + (("[bind]") compile-only (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-type-face . 3) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("bind") non-immediate (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-type-face . 3) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2) + "[ \t\n]" t name (font-lock-variable-name-face . 3)) + (("method" "selector") + non-immediate (font-lock-type-face . 1) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("end-class" "end-interface") + non-immediate (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-type-face . 3)) + (("public" "protected" "class" "exitm" "implementation" "interface" + "methods" "end-methods" "this") + non-immediate (font-lock-keyword-face . 2)) + (("object") non-immediate (font-lock-type-face . 2))) + "Hilighting description for words of the \"Objects\" package") + + +(defvar forth-use-oof nil + "*Non-nil makes forth-mode also hilight words from the \"OOF\" package.") +(defvar forth-oof-words + '((("class") non-immediate (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-type-face . 3)) + (("var") non-immediate (font-lock-type-face . 2) + "[ \t\n]" t name (font-lock-variable-name-face . 3)) + (("method" "early") non-immediate (font-lock-type-face . 2) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("::" "super" "bind" "bound" "link") + immediate (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-function-name-face . 3)) + (("ptr" "asptr" "[]") + immediate (font-lock-keyword-face . 2) + "[ \t\n]" t name (font-lock-variable-name-face . 3)) + (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with" + "endwith") + non-immediate (font-lock-keyword-face . 2)) + (("object") non-immediate (font-lock-type-face . 2))) + "Hilighting description for words of the \"OOF\" package") (defvar forth-local-words nil "List of Forth words to prepend to `forth-words'. Should be set by a -forth source, using a local variables list at the end of the file -(\"Local Variables: ... forth-local-words: ... End:\" construct).") + forth source, using a local variables list at the end of the file + (\"Local Variables: ... forth-local-words: ... End:\" construct).") + +(defvar forth-custom-words nil + "List of Forth words to prepend to `forth-words'. Should be set in your + .emacs.") (defvar forth-hilight-level 3 "*Level of hilighting of Forth code.") + (defvar forth-compiled-words nil "Compiled representation of `forth-words'.") -; todo: -; +(defvar forth-indent-words nil + "List of words that have indentation behaviour. +Each element of `forth-indent-words' should have the form + (MATCHER INDENT1 INDENT2 &optional TYPE) + +MATCHER is either a list of strings to match, or a REGEXP. + If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since + that'll be done automatically by the search routines. -; Wörter ordentlich hilighten, die nicht auf whitespace beginning ( ..)IF -; Additional `forth-use-objects' or -; `forth-use-oof' could be set to non-nil for automatical adding of those -; word-lists. Using local variable list? -; -; Konfiguration über customization groups -; -; Bereich nur auf Wortanfang/ende ausweiten, wenn anfang bzw ende in einem -; Wort liegen (?) -- speed! -; -; User interface -; -; 'forth-word' property muss eindeutig sein! +TYPE might be omitted. If it's specified, the only allowed value is + currently the symbol `non-immediate', meaning that the word will not + have any effect on indentation inside definitions. (:NONAME is a good + example for this kind of word). + +INDENT1 specifies how to indent a word that's located at the beginning + of a line, following any number of whitespaces. + +INDENT2 specifies how to indent words that are not located at the + beginning of a line. + +INDENT1 and INDENT2 are indentation specifications of the form + (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, + specifying how the matching line and all following lines are to be + indented, relative to previous lines. NEXT-INDENT specifies how to indent + following lines, relative to the matching line. + + Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of + `forth-indent-level'. Odd values get an additional + `forth-minor-indent-level' added/substracted. Eg a value of -2 indents + 1 * forth-indent-level to the left, wheras 3 indents + 1 * forth-indent-level + forth-minor-indent-level columns to the right.") + +(setq forth-indent-words + '((("if" "begin" "do" "?do" "+do" "-do" "u+do" + "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "iferror" + "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]") + (0 . 2) (0 . 2)) + ((":" ":noname" "code" "abi-code" "struct" "m:" ":m" "class" + "interface") + (0 . 2) (0 . 2) non-immediate) + ("\\S-+%$" (0 . 2) (0 . 0) non-immediate) + ((";" ";m") (-2 . 0) (0 . -2)) + (("again" "then" "endif" "endtry" "endcase" "endof" + "[then]" "[endif]" "[loop]" "[+loop]" "[next]" + "[until]" "[again]" "loop") + (-2 . 0) (0 . -2)) + (("end-code" "end-class" "end-interface" "end-class-noname" + "end-interface-noname" "end-struct" "class;") + (-2 . 0) (0 . -2) non-immediate) + (("protected" "public" "how:") (-1 . 1) (0 . 0) non-immediate) + (("+loop" "-loop" "until") (-2 . 0) (-2 . 0)) + (("else" "recover" "restore" "endtry-iferror" "[else]") + (-2 . 2) (0 . 0)) + (("does>") (-1 . 1) (0 . 0)) + (("while" "[while]") (-2 . 4) (0 . 2)) + (("repeat" "[repeat]") (-4 . 0) (0 . -4)))) + +(defvar forth-local-indent-words nil + "List of Forth words to prepend to `forth-indent-words', when a forth-mode +buffer is created. Should be set by a Forth source, using a local variables +list at the end of the file (\"Local Variables: ... forth-local-words: ... +End:\" construct).") -(setq debug-on-error t) +(defvar forth-custom-indent-words nil + "List of Forth words to prepend to `forth-indent-words'. Should be set in + your .emacs.") + +(defvar forth-indent-level 4 + "*Indentation of Forth statements.") +(defvar forth-minor-indent-level 2 + "*Minor indentation of Forth statements.") +(defvar forth-compiled-indent-words nil) + +;(setq debug-on-error t) ;; Filter list by predicate. This is a somewhat standard function for ;; functional programming languages. So why isn't it already implemented ;; in Lisp?? (defun forth-filter (predicate list) (let ((filtered nil)) - (mapcar (lambda (item) + (dolist (item list) (when (funcall predicate item) (if filtered (nconc filtered (list item)) - (setq filtered (cons item nil)))) - nil) list) + (setq filtered (cons item nil))))) filtered)) ;; Helper function for `forth-compile-word': return whether word has to be @@ -277,11 +489,14 @@ forth source, using a local variables li ;; Helper function for `forth-compile-word': translate one entry from ;; `forth-words' into the form (regexp regexp-depth word-description) (defun forth-compile-words-mapper (word) + ;; warning: we cannot rely on regexp-opt's PAREN argument, since + ;; XEmacs will use shy parens by default :-( (let* ((matcher (car word)) - (regexp (if (stringp matcher) (concat "\\(" matcher "\\)") - (if (listp matcher) (regexp-opt matcher t) - (error "Invalid matcher (stringp or listp expected `%s'" - matcher)))) + (regexp + (concat "\\(" (cond ((stringp matcher) matcher) + ((listp matcher) (regexp-opt matcher)) + (t (error "Invalid matcher"))) + "\\)")) (depth (regexp-opt-depth regexp)) (description (cdr word))) (list regexp depth description))) @@ -310,7 +525,7 @@ forth source, using a local variables li (defun forth-compile-words () "Compile the the words from `forth-words' and `forth-indent-words' into the format that's later used for doing the actual hilighting/indentation. -Store the resulting compiled wordlists in `forth-compiled-words' and + Store the resulting compiled wordlists in `forth-compiled-words' and `forth-compiled-indent-words', respective" (setq forth-compiled-words (forth-compile-wordlist @@ -319,14 +534,29 @@ Store the resulting compiled wordlists i (forth-compile-wordlist forth-indent-words))) (defun forth-hack-local-variables () - "Parse and bind local variables, set in the contens of the current -forth-mode buffer. Prepend `forth-local-words' to `forth-words' and -`forth-local-indent-words' to `forth-local-words'." + "Parse and bind local variables, set in the contents of the current + forth-mode buffer. Prepend `forth-local-words' to `forth-words' and + `forth-local-indent-words' to `forth-indent-words'." + (put 'forth-local-indent-words 'safe-local-variable 'listp) + (put 'forth-local-words 'safe-local-variable 'listp) (hack-local-variables) (setq forth-words (append forth-local-words forth-words)) (setq forth-indent-words (append forth-local-indent-words forth-indent-words))) +(defun forth-customize-words () + "Add the words from `forth-custom-words' and `forth-custom-indent-words' + to `forth-words' and `forth-indent-words', respective. Add + `forth-objects-words' and/or `forth-oof-words' to `forth-words', if + `forth-use-objects' and/or `forth-use-oof', respective is set." + (setq forth-words (append forth-custom-words forth-words + (if forth-use-oof forth-oof-words nil) + (if forth-use-objects forth-objects-words nil))) + (setq forth-indent-words (append + forth-custom-indent-words forth-indent-words))) + + + ;; get location of first character of previous forth word that's got ;; properties (defun forth-previous-start (pos) @@ -367,13 +597,15 @@ forth-mode buffer. Prepend `forth-local- ;; Delete all properties, used by Forth mode, from `from' to `to'. (defun forth-delete-properties (from to) (remove-text-properties - from to '(face nil forth-parsed nil forth-word nil forth-state nil))) + from to '(face nil fontified nil + forth-parsed nil forth-word nil forth-state nil))) ;; Get the index of the branch of the most recently evaluated regular ;; expression that matched. (used for identifying branches "a\\|b\\|c...") (defun forth-get-regexp-branch () (let ((count 2)) - (while (not (match-beginning count)) + (while (not (condition-case err (match-beginning count) + (args-out-of-range t))) ; XEmacs requires error handling (setq count (1+ count))) count)) @@ -435,11 +667,9 @@ forth-mode buffer. Prepend `forth-local- ;; Search for known Forth words in the range `from' to `to', using ;; `forth-next-known-forth-word' and set their properties via ;; `forth-set-word-properties'. -(defun forth-update-properties (from to) +(defun forth-update-properties (from to &optional loudly) (save-excursion - (let ((msg-flag nil) (state) (word-descr) (last-location)) - (when (> to (+ from 5000)) - (setq msg-flag t) (message "Parsing Forth code...")) + (let ((msg-count 0) (state) (word-descr) (last-location)) (goto-char (forth-previous-word (forth-previous-start (max (point-min) (1- from))))) (setq to (forth-next-end (min (point-max) (1+ to)))) @@ -448,8 +678,14 @@ forth-mode buffer. Prepend `forth-local- (setq state (get-text-property (point) 'forth-state)) (setq last-location (point)) (forth-delete-properties (point) to) + (put-text-property (point) to 'fontified t) ;; hilight loop... (while (setq word-descr (forth-next-known-forth-word to)) + (when loudly + (when (equal 0 (% msg-count 100)) + (message "Parsing Forth code...%s" + (make-string (/ msg-count 100) ?.))) + (setq msg-count (1+ msg-count))) (forth-set-word-properties state word-descr) (when state (put-text-property last-location (point) 'forth-state t)) (let ((type (car word-descr))) @@ -466,33 +702,39 @@ forth-mode buffer. Prepend `forth-local- to 'forth-state (current-buffer) (point-max)))) (forth-update-properties to extend-to)) )) - (when msg-flag (message "Parsing Forth code...done")) ))) ;; save-buffer-state borrowed from `font-lock.el' (eval-when-compile (defmacro forth-save-buffer-state (varlist &rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." - (` (let* ((,@ (append varlist + `(let* (,@(append varlist '((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) before-change-functions after-change-functions - deactivate-mark buffer-file-name buffer-file-truename)))) - (,@ body) + deactivate-mark buffer-file-name buffer-file-truename))) + ,@body (when (and (not modified) (buffer-modified-p)) - (set-buffer-modified-p nil)))))) + (set-buffer-modified-p nil))))) ;; Function that is added to the `change-functions' hook. Calls ;; `forth-update-properties' and keeps care of disabling undo information ;; and stuff like that. -(defun forth-change-function (from to len) +(defun forth-change-function (from to len &optional loudly) + (save-match-data + (forth-save-buffer-state + () + (unless forth-disable-parser (forth-update-properties from to loudly)) + (forth-update-warn-long-lines)))) + +(defun forth-fontification-function (from) + "Function to be called from `fontification-functions' of Emacs 21." (save-match-data - (forth-save-buffer-state () - (unwind-protect - (progn - (forth-update-properties from to) - (forth-update-show-screen) - (forth-update-warn-long-lines)))))) + (forth-save-buffer-state + ((to (min (point-max) (+ from 100)))) + (unless (or forth-disable-parser (not forth-jit-parser) + (get-text-property from 'fontified)) + (forth-update-properties from to))))) (eval-when-compile (byte-compile 'forth-set-word-properties) @@ -501,69 +743,54 @@ forth-mode buffer. Prepend `forth-local- (byte-compile 'forth-delete-properties) (byte-compile 'forth-get-regexp-branch)) +;;; imenu support +;;; +(defvar forth-defining-words + '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT" + "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE" + "DEFER" "ALIAS") + "List of words, that define the following word. +Used for imenu index generation.") + +(defvar forth-defining-words-regexp nil + "Regexp that's generated for matching `forth-defining-words'") + +(defun forth-next-definition-starter () + (progn + (let* ((pos (re-search-forward forth-defining-words-regexp (point-max) t))) + (if pos + (if (or (text-property-not-all (match-beginning 0) (match-end 0) + 'forth-parsed nil) + (text-property-not-all (match-beginning 0) (match-end 0) + 'forth-state nil)) + (forth-next-definition-starter) + t) + nil)))) + +(defun forth-create-index () + (let* ((forth-defining-words-regexp + (concat "\\<\\(" (regexp-opt forth-defining-words) "\\)\\>")) + (index nil)) + (goto-char (point-min)) + (while (forth-next-definition-starter) + (if (looking-at "[ \t]*\\([^ \t\n]+\\)") + (setq index (cons (cons (match-string 1) (point)) index)))) + index)) + +;; top-level require is executed at byte-compile and load time +(eval-and-compile (forth-require 'speedbar)) + +;; this code is executed at load-time only +(when (memq 'speedbar features) + (speedbar-add-supported-extension ".fs") + (speedbar-add-supported-extension ".fb")) + ;; (require 'profile) ;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch)) ;;; Indentation ;;; -(defvar forth-indent-words nil - "List of words that have indentation behaviour. -Each element of `forth-indent-words' should have the form - (MATCHER INDENT1 INDENT2) - -MATCHER is either a list of strings to match, or a REGEXP. - If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since - that'll be done automatically by the search routines. - -INDENT1 specifies how to indent a word that's located at a line's begin, - following any number of whitespaces. - -INDENT2 specifies how to indent words that are not located at a line's begin. - -INDENT1 and INDENT2 are indentation specifications of the form - (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, - specifying how the matching line and all following lines are to be - indented, relative to previous lines. NEXT-INDENT specifies how to indent - following lines, relative to the matching line. - - Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of - `forth-indent-level'. Odd values get an additional - `forth-minor-indent-level' added/substracted. Eg a value of -2 indents - 1 * forth-indent-level to the left, wheras 3 indents - 1 * forth-indent-level + forth-minor-indent-level columns to the right.") - -(setq forth-indent-words - '(((":" ":noname" "code" "if" "begin" "do" "?do" "+do" "-do" "u+do" - "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "struct" - "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]" - "class" "interface" "m:" ":m") - (0 . 2) (0 . 2)) - ((";" ";m") (-2 . 0) (0 . -2)) - (("end-code" "again" "repeat" "then" "endtry" "endcase" "endof" - "end-struct" "[then]" "[endif]" "[loop]" "[+loop]" "[next]" - "[until]" "[repeat]" "[again]" "end-class" "end-interface" - "end-class-noname" "end-interface-noname" "loop" - "class;") - (-2 . 0) (0 . -2)) - (("protected" "public" "how:") (-1 . 1) (0 . 0)) - (("+loop" "-loop" "until") (-2 . 0) (-2 . 0)) - (("else" "recover" "[else]") (-2 . 2) (0 . 0)) - (("while" "does>" "[while]") (-1 . 1) (0 . 0)) - (("\\g") (-2 . 2) (0 . 0)))) - -(defvar forth-local-indent-words nil - "List of Forth words to prepend to `forth-indent-words', when a forth-mode -buffer is created. Should be set by a Forth source, using a local variables -list at the end of the file (\"Local Variables: ... forth-local-words: ... -End:\" construct).") - -(defvar forth-indent-level 4 - "Indentation of Forth statements.") -(defvar forth-minor-indent-level 2 - "Minor indentation of Forth statements.") -(defvar forth-compiled-indent-words nil) - ;; Return, whether `pos' is the first forth word on its line (defun forth-first-word-on-line-p (pos) (save-excursion @@ -581,12 +808,19 @@ End:\" construct).") (let* ((regexp (car forth-compiled-indent-words)) (pos (re-search-forward regexp to t))) (if pos - (if (text-property-not-all (match-beginning 0) (match-end 0) - 'forth-parsed nil) - (forth-next-known-indent-word to) - (let* ((branch (forth-get-regexp-branch)) - (descr (cdr forth-compiled-indent-words)) - (indent (cdr (assoc branch descr)))) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (branch (forth-get-regexp-branch)) + (descr (cdr forth-compiled-indent-words)) + (indent (cdr (assoc branch descr))) + (type (nth 2 indent))) + ;; skip words that are parsed (strings/comments) and + ;; non-immediate words inside definitions + (if (or (text-property-not-all start end 'forth-parsed nil) + (and (eq type 'non-immediate) + (text-property-not-all start end + 'forth-state nil))) + (forth-next-known-indent-word to) (if (forth-first-word-on-line-p (match-beginning 0)) (nth 0 indent) (nth 1 indent)))) nil))) @@ -604,8 +838,8 @@ End:\" construct).") ;; Return the column increment, that the current line of forth code does to ;; the current or following lines. `which' specifies which indentation values -;; to use. 0 means the indentation of following lines relative to current -;; line, 1 means the indentation of the current line relative to the previous +;; to use. 1 means the indentation of following lines relative to current +;; line, 0 means the indentation of the current line relative to the previous ;; line. Return `nil', if there are no indentation words on the current line. (defun forth-get-column-incr (which) (save-excursion @@ -634,8 +868,7 @@ End:\" construct).") (defun forth-get-anchor-column () (save-excursion (if (/= 0 (forward-line -1)) 0 - (let ((next-indent) - (self-indent)) + (let ((indent)) (while (not (or (setq indent (forth-get-column-incr 1)) (<= (point) (point-min)))) (forward-line -1)) @@ -694,7 +927,6 @@ End:\" construct).") (forth-newline-remove-trailing) (indent-according-to-mode)) -;;; end hilighting/indentation ;;; Block file encoding/decoding (dk) ;;; @@ -798,7 +1030,7 @@ done by checking whether the first line (save-restriction (widen) (save-excursion - (beginning-of-buffer) + (goto-char (point-min)) (end-of-line) (>= (current-column) 1024)))) @@ -822,6 +1054,7 @@ done by checking whether the first line "Non-nil means to warn about lines that are longer than 64 characters") (defvar forth-screen-marker nil) +(defvar forth-screen-number-string nil) (defun forth-update-show-screen () "If `forth-show-screen' is non-nil, put overlay arrow to start of screen, @@ -851,7 +1084,7 @@ exceeds 64 characters." forth-c/l)))) (add-hook 'forth-motion-hooks 'forth-update-warn-long-lines) - + ;;; End block file editing @@ -869,8 +1102,6 @@ exceeds 64 characters." ;(define-key forth-mode-map "\M-\C-x" 'compile) (define-key forth-mode-map "\C-x\\" 'comment-region) (define-key forth-mode-map "\C-x~" 'forth-remove-tracers) -(define-key forth-mode-map "\e\C-m" 'forth-send-paragraph) -(define-key forth-mode-map "\eo" 'forth-send-buffer) (define-key forth-mode-map "\C-x\C-m" 'forth-split) (define-key forth-mode-map "\e " 'forth-reload) (define-key forth-mode-map "\t" 'forth-indent-command) @@ -878,57 +1109,34 @@ exceeds 64 characters." (define-key forth-mode-map "\M-q" 'forth-fill-paragraph) (define-key forth-mode-map "\e." 'forth-find-tag) -;;; hook into motion events (realy ugly!) (dk) -(define-key forth-mode-map "\C-n" 'forth-next-line) -(define-key forth-mode-map "\C-p" 'forth-previous-line) -(define-key forth-mode-map [down] 'forth-next-line) -(define-key forth-mode-map [up] 'forth-previous-line) -(define-key forth-mode-map "\C-f" 'forth-forward-char) -(define-key forth-mode-map "\C-b" 'forth-backward-char) -(define-key forth-mode-map [right] 'forth-forward-char) -(define-key forth-mode-map [left] 'forth-backward-char) -(define-key forth-mode-map "\M-f" 'forth-forward-word) -(define-key forth-mode-map "\M-b" 'forth-backward-word) -(define-key forth-mode-map [C-right] 'forth-forward-word) -(define-key forth-mode-map [C-left] 'forth-backward-word) -(define-key forth-mode-map "\M-v" 'forth-scroll-down) -(define-key forth-mode-map "\C-v" 'forth-scroll-up) -(define-key forth-mode-map [prior] 'forth-scroll-down) -(define-key forth-mode-map [next] 'forth-scroll-up) - -(defun forth-next-line (arg) - (interactive "p") (next-line arg) (run-hooks 'forth-motion-hooks)) -(defun forth-previous-line (arg) - (interactive "p") (previous-line arg) (run-hooks 'forth-motion-hooks)) -(defun forth-backward-char (arg) - (interactive "p") (backward-char arg) (run-hooks 'forth-motion-hooks)) -(defun forth-forward-char (arg) - (interactive "p") (forward-char arg) (run-hooks 'forth-motion-hooks)) -(defun forth-forward-word (arg) - (interactive "p") (forward-word arg) (run-hooks 'forth-motion-hooks)) -(defun forth-backward-word (arg) - (interactive "p") (backward-word arg) (run-hooks 'forth-motion-hooks)) -(defun forth-scroll-down (arg) - (interactive "P") (scroll-down arg) (run-hooks 'forth-motion-hooks)) -(defun forth-scroll-up (arg) - (interactive "P") (scroll-up arg) (run-hooks 'forth-motion-hooks)) - -;setup for C-h C-i to work -(if (fboundp 'info-lookup-add-help) - (info-lookup-add-help - :topic 'symbol - :mode 'forth-mode - :regexp "[^ -]+" - :ignore-case t - :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) +;; setup for C-h C-i to work +(eval-and-compile (forth-require 'info-look)) +(when (memq 'info-look features) + (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t + (("(gforth)Word Index")) + "\\S-+"))) + (unless (memq forth-info-lookup info-lookup-alist) + (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))) + ;; in X-Emacs C-h C-i is by default bound to Info-query + (define-key forth-mode-map [?\C-h ?\C-i] 'info-lookup-symbol)) + +;; (info-lookup-add-help +;; :topic 'symbol +;; :mode 'forth-mode +;; :regexp "[^ +;; ]+" +;; :ignore-case t +;; :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) -(load "etags") +(require 'etags) (defun forth-find-tag (tagname &optional next-p regexp-p) (interactive (find-tag-interactive "Find tag: ")) + (unless (or regexp-p next-p) + (setq tagname (concat "\\(^\\|\\s-+\\)\\(" (regexp-quote tagname) + "\\)\\s-*\x7f"))) (switch-to-buffer - (find-tag-noselect (concat " " tagname " ") next-p regexp-p))) + (find-tag-noselect tagname next-p t))) (defvar forth-mode-syntax-table nil "Syntax table in use in Forth-mode buffers.") @@ -949,7 +1157,6 @@ exceeds 64 characters." (setq char (1+ char)))) )) - (defun forth-mode-variables () (set-syntax-table forth-mode-syntax-table) (setq local-abbrev-table forth-mode-abbrev-table) @@ -968,12 +1175,14 @@ exceeds 64 characters." (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-start-skip) - (setq comment-start-skip "\\ ") - (make-local-variable 'comment-indent-hook) - (setq comment-indent-hook 'forth-comment-indent) + (setq comment-start-skip "\\\\ ") + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'forth-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (setq case-fold-search t) + (make-local-variable 'forth-was-point) + (setq forth-was-point -1) (make-local-variable 'forth-words) (make-local-variable 'forth-compiled-words) (make-local-variable 'forth-compiled-indent-words) @@ -983,8 +1192,13 @@ exceeds 64 characters." (make-local-variable 'forth-screen-marker) (make-local-variable 'forth-warn-long-lines) (make-local-variable 'forth-screen-number-string) + (make-local-variable 'forth-use-oof) + (make-local-variable 'forth-use-objects) (setq forth-screen-marker (copy-marker 0)) - (add-hook 'after-change-functions 'forth-change-function)) + (add-hook 'after-change-functions 'forth-change-function) + (if (and forth-jit-parser (>= emacs-major-version 21)) + (add-hook 'fontification-functions 'forth-fontification-function)) + (setq imenu-create-index-function 'forth-create-index)) ;;;###autoload (defun forth-mode () @@ -994,36 +1208,22 @@ are delimited with \\ and newline. Parag only. Block files are autodetected, when read, and converted to normal stream source format. See also `forth-block-mode'. \\{forth-mode-map} - Forth-split - Positions the current buffer on top and a forth-interaction window - below. The window size is controlled by the forth-percent-height - variable (see below). - Forth-reload - Reloads the forth library and restarts the forth process. - Forth-send-buffer - Sends the current buffer, in text representation, as input to the - forth process. - Forth-send-paragraph - Sends the previous or the current paragraph to the forth-process. - Note that the cursor only need to be with in the paragraph to be sent. - forth-documentation - Search for documentation of forward adjacent to cursor. Note! To use - this mode you have to add a line, to your .emacs file, defining the - directories to search through for documentation files (se variable - forth-help-load-path below) e.g. (setq forth-help-load-path '(nil)). - -Variables controlling interaction and startup - forth-percent-height - Tells split how high to make the edit portion, in percent of the - current screen height. - forth-program-name - Tells the library which program name to execute in the interation - window. Variables controlling syntax hilighting/recognition of parsed text: `forth-words' List of words that have a special parsing behaviour and/or should be - hilighted. + hilighted. Add custom words by setting forth-custom-words in your + .emacs, or by setting forth-local-words, in source-files' local + variables lists. + forth-use-objects + Set this variable to non-nil in your .emacs, or in a local variables + list, to hilight and recognize the words from the \"Objects\" package + for object-oriented programming. + forth-use-oof + Same as above, just for the \"OOF\" package. + forth-custom-words + List of custom Forth words to prepend to `forth-words'. Should be set + in your .emacs. forth-local-words List of words to prepend to `forth-words', whenever a forth-mode buffer is created. That variable should be set by Forth sources, using @@ -1034,60 +1234,57 @@ Variables controlling syntax hilighting/ forth-local-words: ... End: [THEN] - forth-objects-words - Hilighting information for the words of the \"Objects\" package for - object-oriented programming. Append it to `forth-words', if you need - it. - forth-oof-words - Hilighting information for the words of the \"OOF\" package. forth-hilight-level Controls how much syntax hilighting is done. Should be in the range + 0..3 Variables controlling indentation style: `forth-indent-words' List of words that influence indentation. - `forth-local-indent-words' + forth-local-indent-words List of words to prepend to `forth-indent-words', similar to - `forth-local-words'. Should be used for specifying file-specific + forth-local-words. Should be used for specifying file-specific indentation, using a local variables list. + forth-custom-indent-words + List of words to prepend to `forth-indent-words'. Should be set in your + .emacs. forth-indent-level Indentation increment/decrement of Forth statements. forth-minor-indent-level Minor indentation increment/decrement of Forth statemens. Variables controlling block-file editing: - `forth-show-screen' + forth-show-screen Non-nil means, that the start of the current screen is marked by an overlay arrow, and screen numbers are displayed in the mode line. This variable is by default nil for `forth-mode' and t for `forth-block-mode'. - `forth-overlay-arrow-string' + forth-overlay-arrow-string String to display as the overlay arrow, when `forth-show-screen' is t. Setting this variable to nil disables the overlay arrow. - `forth-block-base' + forth-block-base Screen number of the first block in a block file. Defaults to 1. - `forth-warn-long-lines' + forth-warn-long-lines Non-nil means that a warning message is displayed whenever you edit or move over a line that is longer than 64 characters (the maximum line length that can be stored into a block file). This variable defaults to t for `forth-block-mode' and to nil for `forth-mode'. -Variables controling documentation search - forth-help-load-path - List of directories to search through to find *.doc - (forth-help-file-suffix) files. Nil means current default directory. - The specified directories must contain at least one .doc file. If it - does not and you still want the load-path to scan that directory, create - an empty file dummy.doc. - forth-help-file-suffix - The file names to search for in each directory specified by - forth-help-load-path. Defaulted to '*.doc'. -" +Variables controlling interaction with the Forth-process (also see +`run-forth'): + forth-program-name + Program invoked by the `run-forth' command (including arguments). + inferior-forth-mode-hook + Hook for customising inferior-forth-mode. + forth-compile-command + Default command to execute on `compile'. +" (interactive) (kill-all-local-variables) (use-local-map forth-mode-map) (setq mode-name "Forth") (setq major-mode 'forth-mode) + (forth-install-motion-hook) ;; convert buffer contents from block file format, if necessary (when (forth-detect-block-file-p) (widen) @@ -1135,8 +1332,10 @@ bell during block file read/write operat (make-local-variable 'compile-command) (setq compile-command "gforth ") (forth-hack-local-variables) + (forth-customize-words) (forth-compile-words) - (forth-change-function (point-min) (point-max) nil))) + (unless (and forth-jit-parser (>= emacs-major-version 21)) + (forth-change-function (point-min) (point-max) nil t)))) (defun forth-fill-paragraph () "Fill comments (starting with '\'; do not fill code (block style @@ -1179,311 +1378,12 @@ programmers who tend to fill code won't (interactive) (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil)) -(defvar forth-program-name "gforth" - "*Program invoked by the `run-forth' command.") - -(defvar forth-band-name nil - "*Band loaded by the `run-forth' command.") - -(defvar forth-program-arguments nil - "*Arguments passed to the Forth program by the `run-forth' command.") - -(defun run-forth (command-line) - "Run an inferior Forth process. Output goes to the buffer `*forth*'. -With argument, asks for a command line. Split up screen and run forth -in the lower portion. The current-buffer when called will stay in the -upper portion of the screen, and all other windows are deleted. -Call run-forth again to make the *forth* buffer appear in the lower -part of the screen." - (interactive - (list (let ((default - (or forth-process-command-line - (forth-default-command-line)))) - (if current-prefix-arg - (read-string "Run Forth: " default) - default)))) - (setq forth-process-command-line command-line) - (forth-start-process command-line) - (forth-split) - (forth-set-runlight forth-runlight:input)) - -(defun run-forth-if-not () - (if (not (forth-process-running-p)) - (run-forth forth-program-name))) - -(defun reset-forth () - "Reset the Forth process." - (interactive) - (let ((process (get-process forth-program-name))) - (cond ((or (not process) - (not (eq (process-status process) 'run)) - (yes-or-no-p -"The Forth process is running, are you SURE you want to reset it? ")) - (message "Resetting Forth process...") - (forth-reload) - (message "Resetting Forth process...done"))))) - -(defun forth-default-command-line () - (concat forth-program-name - (if forth-program-arguments - (concat " " forth-program-arguments) - ""))) - -;;;; Internal Variables - -(defvar forth-process-command-line nil - "Command used to start the most recent Forth process.") - -(defvar forth-previous-send "" - "Most recent expression transmitted to the Forth process.") - -(defvar forth-process-filter-queue '() - "Queue used to synchronize filter actions properly.") - -(defvar forth-prompt "ok" - "The current forth prompt string.") - -(defvar forth-start-hook nil - "If non-nil, a procedure to call when the Forth process is started. -When called, the current buffer will be the Forth process-buffer.") - -(defvar forth-signal-death-message nil - "If non-nil, causes a message to be generated when the Forth process dies.") - -(defvar forth-percent-height 50 - "Tells run-forth how high the upper window should be in percent.") - -(defconst forth-runlight:input ?I - "The character displayed when the Forth process is waiting for input.") - -(defvar forth-mode-string "" - "String displayed in the mode line when the Forth process is running.") - -;;;; Evaluation Commands - -(defun forth-send-string (&rest strings) - "Send the string arguments to the Forth process. -The strings are concatenated and terminated by a newline." - (cond ((forth-process-running-p) - (forth-send-string-1 strings)) - ((yes-or-no-p "The Forth process has died. Reset it? ") - (reset-forth) - (goto-char (point-max)) - (forth-send-string-1 strings)))) - -(defun forth-send-string-1 (strings) - (let ((string (apply 'concat strings))) - (forth-send-string-2 string))) - -(defun forth-send-string-2 (string) - (let ((process (get-process forth-program-name))) - (if (not (eq (current-buffer) (get-buffer forth-program-name))) - (progn - (forth-process-filter-output string) - (forth-process-filter:finish))) - (send-string process (concat string "\n")) - (if (eq (current-buffer) (process-buffer process)) - (set-marker (process-mark process) (point))))) - - -(defun forth-send-region (start end) - "Send the current region to the Forth process. -The region is sent terminated by a newline." - (interactive "r") - (let ((process (get-process forth-program-name))) - (if (and process (eq (current-buffer) (process-buffer process))) - (progn (goto-char end) - (set-marker (process-mark process) end)))) - (forth-send-string "\n" (buffer-substring start end) "\n")) - -(defun forth-end-of-paragraph () - (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n ")) - (if (not (re-search-forward "\n[ \t]*\n" nil t)) - (goto-char (point-max)))) - -(defun forth-send-paragraph () - "Send the current or the previous paragraph to the Forth process" - (interactive) - (let (end) - (save-excursion - (forth-end-of-paragraph) - (skip-chars-backward "\t\n ") - (setq end (point)) - (if (re-search-backward "\n[ \t]*\n" nil t) - (setq start (point)) - (goto-char (point-min))) - (skip-chars-forward "\t\n ") - (forth-send-region (point) end)))) - -(defun forth-send-buffer () - "Send the current buffer to the Forth process." - (interactive) - (if (eq (current-buffer) (forth-process-buffer)) - (error "Not allowed to send this buffer's contents to Forth")) - (forth-send-region (point-min) (point-max))) - - -;;;; Basic Process Control - -(defun forth-start-process (command-line) - (let ((buffer (get-buffer-create "*forth*"))) - (let ((process (get-buffer-process buffer))) - (save-excursion - (set-buffer buffer) - (progn (if process (delete-process process)) - (goto-char (point-max)) - (setq mode-line-process '(": %s")) - (add-to-global-mode-string 'forth-mode-string) - (setq process - (apply 'start-process - (cons forth-program-name - (cons buffer - (forth-parse-command-line - command-line))))) - (set-marker (process-mark process) (point-max)) - (forth-process-filter-initialize t) - (forth-modeline-initialize) - (set-process-sentinel process 'forth-process-sentinel) - (set-process-filter process 'forth-process-filter) - (run-hooks 'forth-start-hook))) - buffer))) - -(defun forth-parse-command-line (string) - (setq string (substitute-in-file-name string)) - (let ((start 0) - (result '())) - (while start - (let ((index (string-match "[ \t]" string start))) - (setq start - (cond ((not index) - (setq result - (cons (substring string start) - result)) - nil) - ((= index start) - (string-match "[^ \t]" string start)) - (t - (setq result - (cons (substring string start index) - result)) - (1+ index)))))) - (nreverse result))) - - -(defun forth-process-running-p () - "True iff there is a Forth process whose status is `run'." - (let ((process (get-process forth-program-name))) - (and process - (eq (process-status process) 'run)))) - -(defun forth-process-buffer () - (let ((process (get-process forth-program-name))) - (and process (process-buffer process)))) - -;;;; Process Filter - -(defun forth-process-sentinel (proc reason) - (let ((inhibit-quit nil)) - (forth-process-filter-initialize (eq reason 'run)) - (if (eq reason 'run) - (forth-modeline-initialize) - (setq forth-mode-string ""))) - (if (and (not (memq reason '(run stop))) - forth-signal-death-message) - (progn (beep) - (message -"The Forth process has died! Do M-x reset-forth to restart it")))) - -(defun forth-process-filter-initialize (running-p) - (setq forth-process-filter-queue (cons '() '())) - (setq forth-prompt "ok")) - - -(defun forth-process-filter (proc string) - (forth-process-filter-output string) - (forth-process-filter:finish)) - -(defun forth-process-filter:enqueue (action) - (let ((next (cons action '()))) - (if (cdr forth-process-filter-queue) - (setcdr (cdr forth-process-filter-queue) next) - (setcar forth-process-filter-queue next)) - (setcdr forth-process-filter-queue next))) - -(defun forth-process-filter:finish () - (while (car forth-process-filter-queue) - (let ((next (car forth-process-filter-queue))) - (setcar forth-process-filter-queue (cdr next)) - (if (not (cdr next)) - (setcdr forth-process-filter-queue '())) - (apply (car (car next)) (cdr (car next)))))) - -;;;; Process Filter Output - -(defun forth-process-filter-output (&rest args) - (if (not (and args - (null (cdr args)) - (stringp (car args)) - (string-equal "" (car args)))) - (forth-process-filter:enqueue - (cons 'forth-process-filter-output-1 args)))) - -(defun forth-process-filter-output-1 (&rest args) - (save-excursion - (forth-goto-output-point) - (apply 'insert-before-markers args))) - -(defun forth-guarantee-newlines (n) - (save-excursion - (forth-goto-output-point) - (let ((stop nil)) - (while (and (not stop) - (bolp)) - (setq n (1- n)) - (if (bobp) - (setq stop t) - (backward-char)))) - (forth-goto-output-point) - (while (> n 0) - (insert-before-markers ?\n) - (setq n (1- n))))) - -(defun forth-goto-output-point () - (let ((process (get-process forth-program-name))) - (set-buffer (process-buffer process)) - (goto-char (process-mark process)))) - -(defun forth-modeline-initialize () - (setq forth-mode-string " ")) - -(defun forth-set-runlight (runlight) - (aset forth-mode-string 0 runlight) - (forth-modeline-redisplay)) - -(defun forth-modeline-redisplay () - (save-excursion (set-buffer (other-buffer))) - (set-buffer-modified-p (buffer-modified-p)) - (sit-for 0)) - -;;;; Process Filter Operations - -(defun add-to-global-mode-string (x) - (cond ((null global-mode-string) - (setq global-mode-string (list "" x " "))) - ((not (memq x global-mode-string)) - (setq global-mode-string - (cons "" - (cons x - (cons " " - (if (equal "" (car global-mode-string)) - (cdr global-mode-string) - global-mode-string)))))))) - - -;; Misc +(define-key forth-mode-map "\C-x\C-e" 'compile) +(define-key forth-mode-map "\C-x\C-n" 'next-error) +(require 'compile) -(setq auto-mode-alist (append auto-mode-alist - '(("\\.fs$" . forth-mode)))) +(defvar forth-compile-command "gforth ") +;(defvar forth-compilation-window-percent-height 30) (defun forth-split () (interactive) @@ -1494,212 +1394,43 @@ The region is sent terminated by a newli (progn (delete-other-windows) (split-window-vertically - (/ (* (screen-height) forth-percent-height) 100)) + (/ (frame-height) 2)) (other-window 1) (switch-to-buffer buffer) (goto-char (point-max)) (other-window 1)))) - -(defun forth-reload () - (interactive) - (let ((process (get-process forth-program-name))) - (if process (kill-process process t))) - (sleep-for 0 100) - (forth-mode)) - - -;; Special section for forth-help - -(defvar forth-help-buffer "*Forth-help*" - "Buffer used to display the requested documentation.") - -(defvar forth-help-load-path nil - "List of directories to search through to find *.doc - (forth-help-file-suffix) files. Nil means current default directory. - The specified directories must contain at least one .doc file. If it - does not and you still want the load-path to scan that directory, create - an empty file dummy.doc.") - -(defvar forth-help-file-suffix "*.doc" - "The file names to search for in each directory.") - -(setq forth-search-command-prefix "grep -n \"^ [^(]* ") -(defvar forth-search-command-suffix "/dev/null") -(defvar forth-grep-error-regexp ": No such file or directory") - -(defun forth-function-called-at-point () - "Return the space delimited word a point." - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) - (skip-chars-backward "^ \t\n" (point-min)) - (if (looking-at "[ \t\n]") - (forward-char 1)) - (let (obj (p (point))) - (skip-chars-forward "^ \t\n") - (buffer-substring p (point)))))) - -(defun forth-help-names-extend-comp (path-list result) - (cond ((null path-list) result) - ((null (car path-list)) - (forth-help-names-extend-comp (cdr path-list) - (concat result forth-help-file-suffix " "))) - (t (forth-help-names-extend-comp - (cdr path-list) (concat result - (expand-file-name (car path-list)) "/" - forth-help-file-suffix " "))))) - -(defun forth-help-names-extended () - (if forth-help-load-path - (forth-help-names-extend-comp forth-help-load-path "") - (error "forth-help-load-path not specified"))) - - -;(define-key forth-mode-map "\C-hf" 'forth-documentation) - -(defun forth-documentation (function) - "Display the full documentation of FORTH word." - (interactive - (let ((fn (forth-function-called-at-point)) - (enable-recursive-minibuffers t) - search-list - val) - (setq val (read-string (format "Describe forth word (default %s): " fn))) - (list (if (equal val "") fn val)))) - (forth-get-doc (concat forth-search-command-prefix - (grep-regexp-quote (concat function " (")) - "[^)]*\-\-\" " (forth-help-names-extended) - forth-search-command-suffix)) - (message "C-x C-m switches back to the forth interaction window")) - -(defun forth-get-doc (command) - "Display the full documentation of command." - (let ((curwin (get-buffer-window (window-buffer))) - reswin - pointmax) - (with-output-to-temp-buffer forth-help-buffer - (progn - (call-process "sh" nil forth-help-buffer t "-c" command) - (setq reswin (get-buffer-window forth-help-buffer)))) - (setq reswin (get-buffer-window forth-help-buffer)) - (select-window reswin) - (save-excursion - (goto-char (setq pointmax (point-max))) - (insert "--------------------\n\n")) - (let (fd doc) - (while (setq fd (forth-get-file-data pointmax)) - (setq doc (forth-get-doc-string fd)) - (save-excursion - (goto-char (point-max)) - (insert (substring (car fd) (string-match "[^/]*$" (car fd))) - ":\n\n" doc "\n"))) - (if (not doc) - (progn (goto-char (point-max)) (insert "Not found")))) - (select-window curwin))) - -(defun forth-skip-error-lines () - (let ((lines 0)) - (save-excursion - (while (re-search-forward forth-grep-error-regexp nil t) - (beginning-of-line) - (forward-line 1) - (setq lines (1+ lines)))) - (forward-line lines))) - -(defun forth-get-doc-string (fd) - "Find file (car fd) and extract documentation from line (nth 1 fd)." - (let (result) - (save-window-excursion - (find-file (car fd)) - (goto-line (nth 1 fd)) - (if (not (eq (nth 1 fd) (1+ (count-lines (point-min) (point))))) - (error "forth-get-doc-string: serious error")) - (if (not (re-search-backward "\n[\t ]*\n" nil t)) - (goto-char (point-min)) - (goto-char (match-end 0))) - (let ((p (point))) - (if (not (re-search-forward "\n[\t ]*\n" nil t)) - (goto-char (point-max))) - (setq result (buffer-substring p (point)))) - (bury-buffer (current-buffer))) - result)) - -(defun forth-get-file-data (limit) - "Parse grep output and return '(filename line#) list. Return nil when - passing limit." - (forth-skip-error-lines) - (if (< (point) limit) - (let ((result (forth-get-file-data-cont limit))) - (forward-line 1) - (beginning-of-line) - result))) - -(defun forth-get-file-data-cont (limit) - (let (result) - (let ((p (point))) - (skip-chars-forward "^:") - (setq result (buffer-substring p (point)))) - (if (< (point) limit) - (let ((p (1+ (point)))) - (forward-char 1) - (skip-chars-forward "^:") - (list result (string-to-int (buffer-substring p (point)))))))) - -(defun grep-regexp-quote (str) - (let ((i 0) (m 1) (res "")) - (while (/= m 0) - (setq m (string-to-char (substring str i))) - (if (/= m 0) - (progn - (setq i (1+ i)) - (if (string-match (regexp-quote (char-to-string m)) - ".*\\^$[]") - (setq res (concat res "\\"))) - (setq res (concat res (char-to-string m)))))) - res)) - - -(define-key forth-mode-map "\C-x\C-e" 'compile) -(define-key forth-mode-map "\C-x\C-n" 'next-error) -(require 'compile "compile") - -(defvar forth-compile-command "gforth ") -;(defvar forth-compilation-window-percent-height 30) - -(defun forth-compile (command) - (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command)))) - (forth-split-1 "*compilation*") - (setq ctools-compile-command command) - (compile1 ctools-compile-command "No more errors")) - ;;; Forth menu ;;; Mikael Karlsson -(cond ((string-match "XEmacs\\|Lucid" emacs-version) - (require 'func-menu) - - (defconst fume-function-name-regexp-forth - "^\\(:\\)[ \t]+\\([^ \t]*\\)" - "Expression to get word definitions in Forth.") - - (setq fume-function-name-regexp-alist - (append '((forth-mode . fume-function-name-regexp-forth) - ) fume-function-name-regexp-alist)) - - ;; Find next forth word in the buffer - (defun fume-find-next-forth-function-name (buffer) - "Searches for the next forth word in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 2)) - (end (match-end 2))) - (cons (buffer-substring beg end) beg)))) +;; (dk) code commented out due to complaints of XEmacs users. After +;; all, there's imenu/speedbar, which uses much smarter scanning +;; rules. + +;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) +;; (require 'func-menu) + +;; (defconst fume-function-name-regexp-forth +;; "^\\(:\\)[ \t]+\\([^ \t]*\\)" +;; "Expression to get word definitions in Forth.") + +;; (setq fume-function-name-regexp-alist +;; (append '((forth-mode . fume-function-name-regexp-forth) +;; ) fume-function-name-regexp-alist)) + +;; ;; Find next forth word in the buffer +;; (defun fume-find-next-forth-function-name (buffer) +;; "Searches for the next forth word in BUFFER." +;; (set-buffer buffer) +;; (if (re-search-forward fume-function-name-regexp nil t) +;; (let ((beg (match-beginning 2)) +;; (end (match-end 2))) +;; (cons (buffer-substring beg end) beg)))) - (setq fume-find-function-name-method-alist - (append '((forth-mode . fume-find-next-forth-function-name)))) +;; (setq fume-find-function-name-method-alist +;; (append '((forth-mode . fume-find-next-forth-function-name)))) - )) +;; )) ;;; End Forth menu ;;; File folding of forth-files @@ -1710,43 +1441,44 @@ The region is sent terminated by a newli ;;; Works most of the times but loses sync with the cursor occasionally ;;; Could be improved by also folding on comments -(require 'outline) +;; (dk) This code needs a rewrite; just too ugly and doesn't use the +;; newer and smarter scanning rules of `imenu'. Who needs it anyway?? + +;; (require 'outline) -(defun f-outline-level () - (cond ((looking-at "\\`\\\\") - 0) - ((looking-at "\\\\ SEC") - 0) - ((looking-at "\\\\ \\\\ .*") - 0) - ((looking-at "\\\\ DEFS") - 1) - ((looking-at "\\/\\* ") - 1) - ((looking-at ": .*") - 1) - ((looking-at "\\\\G") - 2) - ((looking-at "[ \t]+\\\\") - 3)) -) - -(defun fold-f () - (interactive) - (add-hook 'outline-minor-mode-hook 'hide-body) - - ; outline mode header start, i.e. find word definitions -;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") - (setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*") - (setq outline-level 'f-outline-level) - - (outline-minor-mode) - (define-key outline-minor-mode-map '(shift up) 'hide-sublevels) - (define-key outline-minor-mode-map '(shift right) 'show-children) - (define-key outline-minor-mode-map '(shift left) 'hide-subtree) - (define-key outline-minor-mode-map '(shift down) 'show-subtree) +;; (defun f-outline-level () +;; (cond ((looking-at "\\`\\\\") +;; 0) +;; ((looking-at "\\\\ SEC") +;; 0) +;; ((looking-at "\\\\ \\\\ .*") +;; 0) +;; ((looking-at "\\\\ DEFS") +;; 1) +;; ((looking-at "\\/\\* ") +;; 1) +;; ((looking-at ": .*") +;; 1) +;; ((looking-at "\\\\G") +;; 2) +;; ((looking-at "[ \t]+\\\\") +;; 3))) + +;; (defun fold-f () +;; (interactive) +;; (add-hook 'outline-minor-mode-hook 'hide-body) + +;; ; outline mode header start, i.e. find word definitions +;; ;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") +;; (setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*") +;; (setq outline-level 'f-outline-level) + +;; (outline-minor-mode) +;; (define-key outline-minor-mode-map '(shift up) 'hide-sublevels) +;; (define-key outline-minor-mode-map '(shift right) 'show-children) +;; (define-key outline-minor-mode-map '(shift left) 'hide-subtree) +;; (define-key outline-minor-mode-map '(shift down) 'show-subtree)) -) ;;(define-key global-map '(shift up) 'fold-f) @@ -1758,13 +1490,220 @@ The region is sent terminated by a newli ;;; for all of the recognized languages. Scanning the buffer takes some time, ;;; but not much. ;;; -(cond ((string-match "XEmacs\\|Lucid" emacs-version) - (require 'func-menu) -;; (define-key global-map 'f8 'function-menu) - (add-hook 'find-fible-hooks 'fume-add-menubar-entry) -; (define-key global-map "\C-cg" 'fume-prompt-function-goto) -; (define-key global-map '(shift button3) 'mouse-function-menu) -)) +;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) +;; (require 'func-menu) +;; ;; (define-key global-map 'f8 'function-menu) +;; (add-hook 'find-fible-hooks 'fume-add-menubar-entry) +;; ; (define-key global-map "\C-cg" 'fume-prompt-function-goto) +;; ; (define-key global-map '(shift button3) 'mouse-function-menu) +;; )) -;;; gforth.el ends here +;;; +;;; Inferior Forth interpreter +;;; -- mostly copied from `cmuscheme.el' of Emacs 21.2 +;;; + +(eval-and-compile (forth-require 'comint)) + +(when (memq 'comint features) + + (defvar forth-program-name "gforth" + "*Program invoked by the `run-forth' command, including program arguments") + (defcustom inferior-forth-mode-hook nil + "*Hook for customising inferior-forth-mode." + :type 'hook + :group 'forth) + + (defvar inferior-forth-mode-map + (let ((m (make-sparse-keymap))) + (define-key m "\r" 'comint-send-input) + (define-key m "\M-\C-x" 'forth-send-paragraph-and-go) + (define-key m "\C-c\C-l" 'forth-load-file) + m)) + ;; Install the process communication commands in the forth-mode keymap. + (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph-and-go) + (define-key forth-mode-map "\eo" 'forth-send-buffer-and-go) + + (define-key forth-mode-map "\M-\C-x" 'forth-send-paragraph-and-go) + (define-key forth-mode-map "\C-c\C-r" 'forth-send-region) + (define-key forth-mode-map "\C-c\M-r" 'forth-send-region-and-go) + (define-key forth-mode-map "\C-c\C-z" 'forth-switch-to-interactive) + (define-key forth-mode-map "\C-c\C-l" 'forth-load-file) + + (defvar forth-process-buffer) + + (define-derived-mode inferior-forth-mode comint-mode "Inferior Forth" + "Major mode for interacting with an inferior Forth process. + +The following commands are available: +\\{inferior-forth-mode-map} + +A Forth process can be fired up with M-x run-forth. + +Customisation: Entry to this mode runs the hooks on comint-mode-hook and +inferior-forth-mode-hook (in that order). + +You can send text to the inferior Forth process from other buffers containing +Forth source. + forth-switch-to-interactive switches the current buffer to the Forth + process buffer. + forth-send-paragraph sends the current paragraph to the Forth process. + forth-send-region sends the current region to the Forth process. + forth-send-buffer sends the current buffer to the Forth process. + + forth-send-paragraph-and-go, forth-send-region-and-go, + forth-send-buffer-and-go switch to the Forth process buffer after + sending their text. +For information on running multiple processes in multiple buffers, see +documentation for variable `forth-process-buffer'. + +Commands: +Return after the end of the process' output sends the text from the +end of process to point. If you accidentally suspend your process, use +\\[comint-continue-subjob] to continue it. " + ;; Customise in inferior-forth-mode-hook + (setq comint-prompt-regexp "^") + (setq mode-line-process '(":%s"))) + + (defun forth-args-to-list (string) + (let ((where (string-match "[ \t]" string))) + (cond ((null where) (list string)) + ((not (= where 0)) + (cons (substring string 0 where) + (forth-args-to-list (substring string (+ 1 where) + (length string))))) + (t (let ((pos (string-match "[^ \t]" string))) + (if (null pos) + nil + (forth-args-to-list (substring string pos + (length string))))))))) + +;;;###autoload + (defun run-forth (cmd) + "Run an inferior Forth process, input and output via buffer *forth*. +If there is a process already running in `*forth*', switch to that buffer. +With argument, allows you to edit the command line (default is value +of `forth-program-name'). Runs the hooks `inferior-forth-mode-hook' +\(after the `comint-mode-hook' is run). +\(Type \\[describe-mode] in the process buffer for a list of commands.)" + + (interactive (list (if current-prefix-arg + (read-string "Run Forth: " forth-program-name) + forth-program-name))) + (if (not (comint-check-proc "*forth*")) + (let ((cmdlist (forth-args-to-list cmd))) + (set-buffer (apply 'make-comint "forth" (car cmdlist) + nil (cdr cmdlist))) + (inferior-forth-mode))) + (setq forth-program-name cmd) + (setq forth-process-buffer "*forth*") + (pop-to-buffer "*forth*")) + + (defun forth-send-region (start end) + "Send the current region to the inferior Forth process." + (interactive "r") + (comint-send-region (forth-proc) start end) + (comint-send-string (forth-proc) "\n")) + + (defun forth-end-of-paragraph () + (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n ")) + (if (not (re-search-forward "\n[ \t]*\n" nil t)) + (goto-char (point-max)))) + + (defun forth-send-paragraph () + "Send the current or the previous paragraph to the Forth process" + (interactive) + (let (end) + (save-excursion + (forth-end-of-paragraph) + (skip-chars-backward "\t\n ") + (setq end (point)) + (if (null (re-search-backward "\n[ \t]*\n" nil t)) + (goto-char (point-min))) + (skip-chars-forward "\t\n ") + (forth-send-region (point) end)))) + + (defun forth-send-paragraph-and-go () + "Send the current or the previous paragraph to the Forth process. +Then switch to the process buffer." + (interactive) + (forth-send-paragraph) + (forth-switch-to-interactive t)) + + (defun forth-send-buffer () + "Send the current buffer to the Forth process." + (interactive) + (if (eq (current-buffer) forth-process-buffer) + (error "Not allowed to send this buffer's contents to Forth")) + (forth-send-region (point-min) (point-max))) + + (defun forth-send-buffer-and-go () + "Send the current buffer to the Forth process. +Then switch to the process buffer." + (interactive) + (forth-send-buffer) + (forth-switch-to-interactive t)) + + + (defun forth-switch-to-interactive (eob-p) + "Switch to the Forth process buffer. +With argument, position cursor at end of buffer." + (interactive "P") + (if (get-buffer forth-process-buffer) + (pop-to-buffer forth-process-buffer) + (error "No current process buffer. See variable `forth-process-buffer'")) + (cond (eob-p + (push-mark) + (goto-char (point-max))))) + + (defun forth-send-region-and-go (my-start end) + "Send the current region to the inferior Forth process. +Then switch to the process buffer." + (interactive "r") + (forth-send-region my-start end) + (forth-switch-to-interactive t)) + + (defcustom forth-source-modes '(forth-mode forth-block-mode) + "*Used to determine if a buffer contains Forth source code. +If it's loaded into a buffer that is in one of these major modes, it's +considered a Forth source file by `forth-load-file' and `forth-compile-file'. +Used by these commands to determine defaults." + :type '(repeat function) + :group 'forth) + + (defvar forth-prev-l/c-dir/file nil + "Caches the last (directory . file) pair. +Caches the last pair used in the last `forth-load-file' or +`forth-compile-file' command. Used for determining the default in the +next one.") + + (defun forth-load-file (file-name) + "Load a Forth file FILE-NAME into the inferior Forth process." + (interactive (comint-get-source "Load Forth file: " forth-prev-l/c-dir/file + forth-source-modes t)) ; T because LOAD + ; needs an exact name + (comint-check-source file-name) ; Check to see if buffer needs saved. + (setq forth-prev-l/c-dir/file (cons (file-name-directory file-name) + (file-name-nondirectory file-name))) + (comint-send-string (forth-proc) + (concat "s\" " file-name "\" included\n"))) + + + (defvar forth-process-buffer nil "*The current Forth process buffer. + +See `scheme-buffer' for an explanation on how to run multiple Forth +processes.") + + (defun forth-proc () + "Return the current Forth process. See variable `forth-process-buffer'." + (let ((proc (get-buffer-process (if (eq major-mode 'inferior-forth-mode) + (current-buffer) + forth-process-buffer)))) + (or proc + (error "No current process. See variable `forth-process-buffer'")))) + ) ; (memq 'comint features) + +(provide 'forth-mode) + +;;; gforth.el ends here