Annotation of gforth/gforth.el, revision 1.88
1.48 pazsan 1: ;;; gforth.el --- major mode for editing (G)Forth sources
1.31 anton 2:
1.88 ! anton 3: ;; Copyright (C) 1995,1996,1997,1998,2000,2001,2003,2004,2007,2008,2010,2011,2012 Free Software Foundation, Inc.
1.31 anton 4:
5: ;; This file is part of Gforth.
1.1 anton 6:
1.17 anton 7: ;; GForth is distributed in the hope that it will be useful,
1.1 anton 8: ;; but WITHOUT ANY WARRANTY. No author or distributor
9: ;; accepts responsibility to anyone for the consequences of using it
10: ;; or for whether it serves any particular purpose or works at all,
11: ;; unless he says so in writing. Refer to the GNU Emacs General Public
12: ;; License for full details.
13:
14: ;; Everyone is granted permission to copy, modify and redistribute
15: ;; GNU Emacs, but only under the conditions described in the
16: ;; GNU Emacs General Public License. A copy of this license is
1.17 anton 17: ;; supposed to have been given to you along with Gforth so you
1.1 anton 18: ;; can know your rights and responsibilities. It should be in a
19: ;; file named COPYING. Among other things, the copyright notice
20: ;; and this notice must be preserved on all copies.
1.31 anton 21:
1.48 pazsan 22: ;; Author: Goran Rydqvist <gorry@ida.liu.se>
23: ;; Maintainer: David Kühling <dvdkhlng@gmx.de>
24: ;; Created: 16 July 88 by Goran Rydqvist
25: ;; Keywords: forth, gforth
26:
1.31 anton 27: ;; Changes by anton
28: ;; This is a variant of forth.el that came with TILE.
29: ;; I left most of this stuff untouched and made just a few changes for
30: ;; the things I use (mainly indentation and syntax tables).
31: ;; So there is still a lot of work to do to adapt this to gforth.
1.1 anton 32:
1.48 pazsan 33: ;; Changes by David
34: ;; Added a syntax-hilighting engine, rewrote auto-indentation engine.
35: ;; Added support for block files.
1.66 dvdkhlng 36: ;; Replaced forth-process code with comint-based implementation.
37:
38: ;; Tested with Emacs 19.34, 20.5, 21 and XEmacs 21
1.48 pazsan 39:
1.1 anton 40: ;;-------------------------------------------------------------------
41: ;; A Forth indentation, documentation search and interaction library
42: ;;-------------------------------------------------------------------
43: ;;
44: ;; Written by Goran Rydqvist, gorry@ida.liu.se, Summer 1988
45: ;; Started: 16 July 88
46: ;; Version: 2.10
47: ;; Last update: 5 December 1989 by Mikael Patel, mip@ida.liu.se
48: ;; Last update: 25 June 1990 by Goran Rydqvist, gorry@ida.liu.se
49: ;;
50: ;; Documentation: See forth-mode (^HF forth-mode)
51: ;;-------------------------------------------------------------------
52:
1.48 pazsan 53: ;;; Code:
54:
1.59 dvdkhlng 55: ;(setq debug-on-error t)
1.58 dvdkhlng 56:
1.55 dvdkhlng 57: ;; Code ripped from `version.el' for compatability with Emacs versions
58: ;; prior to 19.23.
1.58 dvdkhlng 59: (if (not (boundp 'emacs-major-version))
60: (defconst emacs-major-version
61: (progn (string-match "^[0-9]+" emacs-version)
1.75 pazsan 62: (string-to-number (match-string 0 emacs-version)))))
1.58 dvdkhlng 63:
1.73 anton 64: ;; Code ripped from `subr.el' for compatability with Emacs versions
65: ;; prior to 20.1
66: (eval-when-compile
1.58 dvdkhlng 67: (defun forth-emacs-older (major minor)
68: (or (< emacs-major-version major)
69: (and (= emacs-major-version major) (< emacs-minor-version minor))))
1.55 dvdkhlng 70:
1.58 dvdkhlng 71: (if (forth-emacs-older 20 1)
72: (progn
73: (defmacro when (cond &rest body)
74: "If COND yields non-nil, do BODY, else return nil."
75: (list 'if cond (cons 'progn body)))
76: (defmacro unless (cond &rest body)
77: "If COND yields nil, do BODY, else return nil."
78: (cons 'if (cons cond (cons nil body)))))))
79:
80: ;; `no-error' argument of require not supported in Emacs versions
81: ;; prior to 20.4 :-(
1.73 anton 82: (eval-and-compile
1.58 dvdkhlng 83: (defun forth-require (feature)
1.73 anton 84: (condition-case err (require feature) (error nil))))
1.58 dvdkhlng 85:
86: (require 'font-lock)
1.48 pazsan 87:
1.58 dvdkhlng 88: ;; define `font-lock-warning-face' in emacs-versions prior to 20.1
89: ;; (ripped from `font-lock.el')
90: (unless (boundp 'font-lock-warning-face)
91: (message "defining font-lock-warning-face")
92: (make-face 'font-lock-warning-face)
93: (defvar font-lock-warning-face 'font-lock-warning-face)
94: (set-face-foreground font-lock-warning-face "red")
95: (make-face-bold font-lock-warning-face))
96:
1.59 dvdkhlng 97: ;; define `font-lock-constant-face' in XEmacs (just copy
98: ;; `font-lock-preprocessor-face')
99: (unless (boundp 'font-lock-constant-face)
1.61 dvdkhlng 100: (copy-face font-lock-preprocessor-face 'font-lock-constant-face))
101:
1.59 dvdkhlng 102:
1.58 dvdkhlng 103: ;; define `regexp-opt' in emacs versions prior to 20.1
104: ;; (this implementation is extremely inefficient, though)
1.59 dvdkhlng 105: (eval-and-compile (forth-require 'regexp-opt))
106: (unless (memq 'regexp-opt features)
1.58 dvdkhlng 107: (message (concat
108: "Warning: your Emacs version doesn't support `regexp-opt'. "
109: "Hilighting will be slow."))
110: (defun regexp-opt (STRINGS &optional PAREN)
111: (let ((open (if PAREN "\\(" "")) (close (if PAREN "\\)" "")))
112: (concat open (mapconcat 'regexp-quote STRINGS "\\|") close)))
113: (defun regexp-opt-depth (re)
114: (if (string= (substring re 0 2) "\\(") 1 0)))
115:
1.57 dvdkhlng 116: ; todo:
117: ;
118:
1.69 dvdkhlng 119: ; screen-height existiert nicht in XEmacs, frame-height ersetzen?
120: ;
121:
1.57 dvdkhlng 122: ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF
123: ; -- mit aktueller Konzeption nicht möglich??
124: ;
125: ; Konfiguration über customization groups
126: ;
127: ; Bereich nur auf Wortanfang/ende ausweiten, wenn Anfang bzw Ende in einem
128: ; Wort liegen (?) -- speed!
129: ;
130: ; 'forth-word' property muss eindeutig sein!
131: ;
132: ; Forth-Menu
133: ;
134: ; Interface zu GForth Prozessen (Patches von Michael Scholz)
135: ;
136: ; Byte-compile-Code rausschmeißen, Compilieren im Makefile über Emacs
137: ; batch-Modus
138: ;
139: ; forth-help Kram rausschmeißen
140: ;
141: ; XEmacs Kompatibilität? imenu/speedbar -> fume?
142: ;
143: ; Folding neuschreiben (neue Parser-Informationen benutzen)
144:
1.62 dvdkhlng 145: ;;; Motion-hooking (dk)
146: ;;;
147: (defun forth-idle-function ()
148: "Function that is called when Emacs is idle to detect cursor motion
149: in forth-block-mode buffers (which is mainly used for screen number
150: display in). Currently ignores forth-mode buffers but that may change
151: in the future."
152: (if (eq major-mode 'forth-block-mode)
153: (forth-check-motion)))
154:
155: (defvar forth-idle-function-timer nil
156: "Timer that runs `forth-idle-function' or nil if no timer installed.")
157:
158: (defun forth-install-motion-hook ()
159: "Install the motion-hooking mechanism. Currently uses idle timers
160: but might be transparently changed in the future."
161: (unless forth-idle-function-timer
162: ;; install idle function only once (first time forth-mode is used)
163: (setq forth-idle-function-timer
164: (run-with-idle-timer .05 t 'forth-idle-function))))
165:
166: (defvar forth-was-point nil)
167:
168: (defun forth-check-motion ()
169: "Run `forth-motion-hooks', if `point' changed since last call. This
170: used to be called via `post-command-hook' but uses idle timers now as
171: users complaint about lagging performance."
172: (when (or (eq forth-was-point nil) (/= forth-was-point (point)))
173: (setq forth-was-point (point))
174: (run-hooks 'forth-motion-hooks)))
175:
176:
177: ;;; Hilighting and indentation engine (dk)
1.48 pazsan 178: ;;;
1.55 dvdkhlng 179: (defvar forth-disable-parser nil
180: "*Non-nil means to disable on-the-fly parsing of Forth-code.
181:
182: This will disable hilighting of forth-mode buffers and will decrease
183: the smartness of the indentation engine. Only set it to non-nil, if
184: your computer is very slow. To disable hilighting, set
185: `forth-hilight-level' to zero.")
186:
187: (defvar forth-jit-parser nil
188: "*Non-nil means to parse Forth-code just-in-time.
189:
190: This eliminates the need for initially parsing forth-mode buffers and
191: thus speeds up loading of Forth files. That feature is only available
192: in Emacs21 (and newer versions).")
193:
1.48 pazsan 194: (defvar forth-words nil
195: "List of words for hilighting and recognition of parsed text areas.
1.55 dvdkhlng 196:
197: Hilighting of object-oriented Forth code is achieved, by appending either
198: `forth-objects-words' or `forth-oof-words' to the list, depending on the values of `forth-use-objects' or `forth-use-oof'.
199:
200: After `forth-words' changed, `forth-compile-words' must be called to
201: make the changes take effect.
1.48 pazsan 202:
203: Each item of `forth-words' has the form
204: (MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...)
205:
206: MATCHER is either a list of strings to match, or a REGEXP.
207: If it's a REGEXP, it should not be surrounded by '\\<' or '\\>', since
208: that'll be done automatically by the search routines.
209:
210: TYPE should be one of 'definiton-starter', 'definition-ender', 'compile-only',
211: 'immediate' or 'non-immediate'. Those information are required to determine
212: whether a word actually parses (and whether that parsed text needs to be
213: hilighted).
214:
215: HILIGHT is a cons cell of the form (FACE . MINIMUM-LEVEL)
216: Where MINIMUM-LEVEL specifies the minimum value of `forth-hilight-level',
217: that's required for matching text to be hilighted.
218:
219: PARSED-TEXT specifies whether and how a word parses following text. You can
220: specify as many subsequent PARSED-TEXT as you wish, but that shouldn't be
221: necessary very often. It has the following form:
222: (DELIM-REGEXP SKIP-LEADING-FLAG PARSED-TYPE HILIGHT)
223:
224: DELIM-REGEXP is a regular expression that should match strings of length 1,
225: which are delimiters for the parsed text.
226:
227: A non-nil value for PARSE-LEADING-FLAG means, that leading delimiter strings
228: before parsed text should be skipped. This is the parsing behaviour of the
229: Forth word WORD. Set it to t for name-parsing words, nil for comments and
230: strings.
231:
232: PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name',
233: 'string' or 'comment'.")
234: (setq forth-words
235: '(
236: (("[") definition-ender (font-lock-keyword-face . 1))
237: (("]" "]l") definition-starter (font-lock-keyword-face . 1))
238: ((":") definition-starter (font-lock-keyword-face . 1)
239: "[ \t\n]" t name (font-lock-function-name-face . 3))
1.87 pazsan 240: (("event:") definition-starter (font-lock-keyword-face . 1)
241: "[ \t\n]" t name (font-lock-function-name-face . 3))
1.48 pazsan 242: (("immediate" "compile-only" "restrict")
243: immediate (font-lock-keyword-face . 1))
244: (("does>") compile-only (font-lock-keyword-face . 1))
245: ((":noname") definition-starter (font-lock-keyword-face . 1))
1.79 anton 246: ((";" ";code" ";abi-code") definition-ender (font-lock-keyword-face . 1))
1.48 pazsan 247: (("include" "require" "needs" "use")
248: non-immediate (font-lock-keyword-face . 1)
249: "[\n\t ]" t string (font-lock-string-face . 1))
250: (("included" "required" "thru" "load")
251: non-immediate (font-lock-keyword-face . 1))
1.77 dvdkhlng 252: (("code" "abi-code")
253: non-immediate (font-lock-keyword-face . 1)
254: "[ \t\n]" t name (font-lock-function-name-face . 3))
255: (("end-code")
256: non-immediate (font-lock-keyword-face . 1))
1.48 pazsan 257: (("[char]") compile-only (font-lock-keyword-face . 1)
258: "[ \t\n]" t string (font-lock-string-face . 1))
259: (("char") non-immediate (font-lock-keyword-face . 1)
260: "[ \t\n]" t string (font-lock-string-face . 1))
1.81 dvdkhlng 261: ("'.'?" non-immediate (font-lock-string-face . 1))
1.83 dvdkhlng 262: (("s\"" "c\"" "s\\\"") immediate (font-lock-string-face . 1)
1.48 pazsan 263: "[\"\n]" nil string (font-lock-string-face . 1))
1.83 dvdkhlng 264: ((".\"" ".\\\"") compile-only (font-lock-string-face . 1)
1.48 pazsan 265: "[\"\n]" nil string (font-lock-string-face . 1))
266: (("abort\"") compile-only (font-lock-keyword-face . 1)
267: "[\"\n]" nil string (font-lock-string-face . 1))
268: (("{") compile-only (font-lock-variable-name-face . 1)
269: "[\n}]" nil name (font-lock-variable-name-face . 1))
270: ((".(" "(") immediate (font-lock-comment-face . 1)
271: ")" nil comment (font-lock-comment-face . 1))
272: (("\\" "\\G") immediate (font-lock-comment-face . 1)
273: "[\n]" nil comment (font-lock-comment-face . 1))
274:
275: (("[if]" "[?do]" "[do]" "[for]" "[begin]"
276: "[endif]" "[then]" "[loop]" "[+loop]" "[next]" "[until]" "[repeat]"
277: "[again]" "[while]" "[else]")
278: immediate (font-lock-keyword-face . 2))
279: (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2)
280: "[ \t\n]" t name (font-lock-function-name-face . 3))
281: (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for"
1.60 anton 282: "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until"
1.64 pazsan 283: "repeat" "again" "leave" "?leave"
1.48 pazsan 284: "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try"
1.72 anton 285: "recover" "endtry" "iferror" "restore" "endtry-iferror"
286: "assert(" "assert0(" "assert1(" "assert2("
1.48 pazsan 287: "assert3(" ")" "<interpretation" "<compilation" "interpretation>"
288: "compilation>")
289: compile-only (font-lock-keyword-face . 2))
290:
291: (("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w")
292: non-immediate (font-lock-constant-face . 2))
1.56 dvdkhlng 293: (("~~" "break:" "dbg") compile-only (font-lock-warning-face . 2))
1.55 dvdkhlng 294: (("break\"") compile-only (font-lock-warning-face . 1)
295: "[\"\n]" nil string (font-lock-string-face . 1))
1.48 pazsan 296: (("postpone" "[is]" "defers" "[']" "[compile]")
297: compile-only (font-lock-keyword-face . 2)
298: "[ \t\n]" t name (font-lock-function-name-face . 3))
299: (("is" "what's") immediate (font-lock-keyword-face . 2)
300: "[ \t\n]" t name (font-lock-function-name-face . 3))
1.56 dvdkhlng 301: (("<is>" "'" "see") non-immediate (font-lock-keyword-face . 2)
1.48 pazsan 302: "[ \t\n]" t name (font-lock-function-name-face . 3))
303: (("[to]") compile-only (font-lock-keyword-face . 2)
304: "[ \t\n]" t name (font-lock-variable-name-face . 3))
305: (("to") immediate (font-lock-keyword-face . 2)
306: "[ \t\n]" t name (font-lock-variable-name-face . 3))
307: (("<to>") non-immediate (font-lock-keyword-face . 2)
308: "[ \t\n]" t name (font-lock-variable-name-face . 3))
309:
310: (("create" "variable" "constant" "2variable" "2constant" "fvariable"
311: "fconstant" "value" "field" "user" "vocabulary"
1.83 dvdkhlng 312: "create-interpret/compile" "interpret/compile:")
1.48 pazsan 313: non-immediate (font-lock-type-face . 2)
314: "[ \t\n]" t name (font-lock-variable-name-face . 3))
1.54 dvdkhlng 315: ("\\S-+%" non-immediate (font-lock-type-face . 2))
1.48 pazsan 316: (("defer" "alias" "create-interpret/compile:")
317: non-immediate (font-lock-type-face . 1)
318: "[ \t\n]" t name (font-lock-function-name-face . 3))
319: (("end-struct") non-immediate (font-lock-keyword-face . 2)
320: "[ \t\n]" t name (font-lock-type-face . 3))
1.80 dvdkhlng 321: (("struct" "end-c-library" "c-library-name")
322: non-immediate (font-lock-keyword-face . 2))
323: (("c-library") non-immediate (font-lock-keyword-face . 2)
324: "[ \t\n]" t name (font-lock-variable-name-face . 3))
325: (("c-variable") non-immediate (font-lock-type-face . 1)
326: "[ \t\n]" t name (font-lock-function-name-face . 3)
327: "[ \t\n]" t name (font-lock-function-name-face . 3))
328: (("c-function" "c-value") non-immediate (font-lock-type-face . 1)
329: "[ \t\n]" t name (font-lock-function-name-face . 3)
330: "[ \t\n]" t name (font-lock-function-name-face . 3)
331: "[\n]" nil comment (font-lock-variable-name-face . 3))
332: (("\\c") non-immediate (font-lock-keyword-face . 1)
333: "[\n]" nil string (font-lock-string-face . 1))
1.48 pazsan 334: ("-?[0-9]+\\(\\.[0-9]*e\\(-?[0-9]+\\)?\\|\\.?[0-9a-f]*\\)"
335: immediate (font-lock-constant-face . 3))
1.77 dvdkhlng 336: ("-?\\([&#][0-9]+\\|\\(0x\\|\\$\\)[0-9a-f]+\\|%[01]+\\)"
337: immediate (font-lock-constant-face . 3))
1.48 pazsan 338: ))
339:
1.51 dvdkhlng 340: (defvar forth-use-objects nil
341: "*Non-nil makes forth-mode also hilight words from the \"Objects\" package.")
1.57 dvdkhlng 342: (defvar forth-objects-words
343: '(((":m") definition-starter (font-lock-keyword-face . 1)
344: "[ \t\n]" t name (font-lock-function-name-face . 3))
345: (("m:") definition-starter (font-lock-keyword-face . 1))
346: ((";m") definition-ender (font-lock-keyword-face . 1))
347: (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1)
348: "[ \t\n]" t name (font-lock-function-name-face . 3))
349: (("current" "overrides") non-immediate (font-lock-keyword-face . 2)
350: "[ \t\n]" t name (font-lock-function-name-face . 3))
351: (("[to-inst]") compile-only (font-lock-keyword-face . 2)
352: "[ \t\n]" t name (font-lock-variable-name-face . 3))
353: (("[bind]") compile-only (font-lock-keyword-face . 2)
354: "[ \t\n]" t name (font-lock-type-face . 3)
355: "[ \t\n]" t name (font-lock-function-name-face . 3))
356: (("bind") non-immediate (font-lock-keyword-face . 2)
357: "[ \t\n]" t name (font-lock-type-face . 3)
358: "[ \t\n]" t name (font-lock-function-name-face . 3))
359: (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2)
360: "[ \t\n]" t name (font-lock-variable-name-face . 3))
361: (("method" "selector")
362: non-immediate (font-lock-type-face . 1)
363: "[ \t\n]" t name (font-lock-function-name-face . 3))
364: (("end-class" "end-interface")
365: non-immediate (font-lock-keyword-face . 2)
366: "[ \t\n]" t name (font-lock-type-face . 3))
367: (("public" "protected" "class" "exitm" "implementation" "interface"
368: "methods" "end-methods" "this")
369: non-immediate (font-lock-keyword-face . 2))
370: (("object") non-immediate (font-lock-type-face . 2)))
1.51 dvdkhlng 371: "Hilighting description for words of the \"Objects\" package")
1.57 dvdkhlng 372:
1.48 pazsan 373:
1.51 dvdkhlng 374: (defvar forth-use-oof nil
375: "*Non-nil makes forth-mode also hilight words from the \"OOF\" package.")
1.57 dvdkhlng 376: (defvar forth-oof-words
377: '((("class") non-immediate (font-lock-keyword-face . 2)
378: "[ \t\n]" t name (font-lock-type-face . 3))
379: (("var") non-immediate (font-lock-type-face . 2)
380: "[ \t\n]" t name (font-lock-variable-name-face . 3))
381: (("method" "early") non-immediate (font-lock-type-face . 2)
382: "[ \t\n]" t name (font-lock-function-name-face . 3))
383: (("::" "super" "bind" "bound" "link")
384: immediate (font-lock-keyword-face . 2)
385: "[ \t\n]" t name (font-lock-function-name-face . 3))
386: (("ptr" "asptr" "[]")
387: immediate (font-lock-keyword-face . 2)
388: "[ \t\n]" t name (font-lock-variable-name-face . 3))
389: (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with"
390: "endwith")
391: non-immediate (font-lock-keyword-face . 2))
392: (("object") non-immediate (font-lock-type-face . 2)))
1.51 dvdkhlng 393: "Hilighting description for words of the \"OOF\" package")
1.48 pazsan 394:
1.49 dvdkhlng 395: (defvar forth-local-words nil
396: "List of Forth words to prepend to `forth-words'. Should be set by a
1.51 dvdkhlng 397: forth source, using a local variables list at the end of the file
398: (\"Local Variables: ... forth-local-words: ... End:\" construct).")
399:
400: (defvar forth-custom-words nil
401: "List of Forth words to prepend to `forth-words'. Should be set in your
402: .emacs.")
1.49 dvdkhlng 403:
1.48 pazsan 404: (defvar forth-hilight-level 3 "*Level of hilighting of Forth code.")
1.51 dvdkhlng 405:
1.48 pazsan 406: (defvar forth-compiled-words nil "Compiled representation of `forth-words'.")
407:
1.57 dvdkhlng 408: (defvar forth-indent-words nil
409: "List of words that have indentation behaviour.
410: Each element of `forth-indent-words' should have the form
411: (MATCHER INDENT1 INDENT2 &optional TYPE)
412:
413: MATCHER is either a list of strings to match, or a REGEXP.
414: If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since
415: that'll be done automatically by the search routines.
416:
417: TYPE might be omitted. If it's specified, the only allowed value is
418: currently the symbol `non-immediate', meaning that the word will not
419: have any effect on indentation inside definitions. (:NONAME is a good
420: example for this kind of word).
421:
1.63 anton 422: INDENT1 specifies how to indent a word that's located at the beginning
423: of a line, following any number of whitespaces.
1.57 dvdkhlng 424:
1.63 anton 425: INDENT2 specifies how to indent words that are not located at the
426: beginning of a line.
1.57 dvdkhlng 427:
428: INDENT1 and INDENT2 are indentation specifications of the form
429: (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value,
430: specifying how the matching line and all following lines are to be
431: indented, relative to previous lines. NEXT-INDENT specifies how to indent
432: following lines, relative to the matching line.
433:
434: Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of
435: `forth-indent-level'. Odd values get an additional
436: `forth-minor-indent-level' added/substracted. Eg a value of -2 indents
437: 1 * forth-indent-level to the left, wheras 3 indents
438: 1 * forth-indent-level + forth-minor-indent-level columns to the right.")
439:
440: (setq forth-indent-words
441: '((("if" "begin" "do" "?do" "+do" "-do" "u+do"
1.72 anton 442: "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "iferror"
1.57 dvdkhlng 443: "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]")
444: (0 . 2) (0 . 2))
1.77 dvdkhlng 445: ((":" ":noname" "code" "abi-code" "struct" "m:" ":m" "class"
1.80 dvdkhlng 446: "interface" "c-library" "c-library-name")
1.57 dvdkhlng 447: (0 . 2) (0 . 2) non-immediate)
448: ("\\S-+%$" (0 . 2) (0 . 0) non-immediate)
449: ((";" ";m") (-2 . 0) (0 . -2))
1.63 anton 450: (("again" "then" "endif" "endtry" "endcase" "endof"
1.57 dvdkhlng 451: "[then]" "[endif]" "[loop]" "[+loop]" "[next]"
1.63 anton 452: "[until]" "[again]" "loop")
1.57 dvdkhlng 453: (-2 . 0) (0 . -2))
454: (("end-code" "end-class" "end-interface" "end-class-noname"
1.80 dvdkhlng 455: "end-interface-noname" "end-struct" "class;" "end-c-library")
1.57 dvdkhlng 456: (-2 . 0) (0 . -2) non-immediate)
457: (("protected" "public" "how:") (-1 . 1) (0 . 0) non-immediate)
458: (("+loop" "-loop" "until") (-2 . 0) (-2 . 0))
1.72 anton 459: (("else" "recover" "restore" "endtry-iferror" "[else]")
460: (-2 . 2) (0 . 0))
1.79 anton 461: (("does>" ";code" ";abi-code") (-1 . 1) (0 . 0))
1.63 anton 462: (("while" "[while]") (-2 . 4) (0 . 2))
1.70 dvdkhlng 463: (("repeat" "[repeat]") (-4 . 0) (0 . -4))))
1.57 dvdkhlng 464:
465: (defvar forth-local-indent-words nil
466: "List of Forth words to prepend to `forth-indent-words', when a forth-mode
467: buffer is created. Should be set by a Forth source, using a local variables
468: list at the end of the file (\"Local Variables: ... forth-local-words: ...
469: End:\" construct).")
1.51 dvdkhlng 470:
1.57 dvdkhlng 471: (defvar forth-custom-indent-words nil
472: "List of Forth words to prepend to `forth-indent-words'. Should be set in
473: your .emacs.")
1.48 pazsan 474:
1.57 dvdkhlng 475: (defvar forth-indent-level 4
476: "*Indentation of Forth statements.")
477: (defvar forth-minor-indent-level 2
478: "*Minor indentation of Forth statements.")
479: (defvar forth-compiled-indent-words nil)
1.48 pazsan 480:
1.55 dvdkhlng 481: ;(setq debug-on-error t)
1.48 pazsan 482:
1.50 dvdkhlng 483: ;; Filter list by predicate. This is a somewhat standard function for
1.48 pazsan 484: ;; functional programming languages. So why isn't it already implemented
485: ;; in Lisp??
1.50 dvdkhlng 486: (defun forth-filter (predicate list)
1.48 pazsan 487: (let ((filtered nil))
1.75 pazsan 488: (dolist (item list)
1.50 dvdkhlng 489: (when (funcall predicate item)
1.48 pazsan 490: (if filtered
491: (nconc filtered (list item))
1.75 pazsan 492: (setq filtered (cons item nil)))))
1.48 pazsan 493: filtered))
494:
495: ;; Helper function for `forth-compile-word': return whether word has to be
496: ;; added to the compiled word list, for syntactic parsing and hilighting.
497: (defun forth-words-filter (word)
498: (let* ((hilight (nth 2 word))
499: (level (cdr hilight))
500: (parsing-flag (nth 3 word)))
501: (or parsing-flag
502: (<= level forth-hilight-level))))
503:
504: ;; Helper function for `forth-compile-word': translate one entry from
505: ;; `forth-words' into the form (regexp regexp-depth word-description)
506: (defun forth-compile-words-mapper (word)
1.59 dvdkhlng 507: ;; warning: we cannot rely on regexp-opt's PAREN argument, since
508: ;; XEmacs will use shy parens by default :-(
1.48 pazsan 509: (let* ((matcher (car word))
1.59 dvdkhlng 510: (regexp
511: (concat "\\(" (cond ((stringp matcher) matcher)
512: ((listp matcher) (regexp-opt matcher))
1.75 pazsan 513: (t (error "Invalid matcher")))
1.59 dvdkhlng 514: "\\)"))
1.48 pazsan 515: (depth (regexp-opt-depth regexp))
516: (description (cdr word)))
517: (list regexp depth description)))
518:
519: ;; Read `words' and create a compiled representation suitable for efficient
520: ;; parsing of the form
521: ;; (regexp (subexp-count word-description) (subexp-count2 word-description2)
522: ;; ...)
1.49 dvdkhlng 523: (defun forth-compile-wordlist (words)
1.48 pazsan 524: (let* ((mapped (mapcar 'forth-compile-words-mapper words))
525: (regexp (concat "\\<\\("
526: (mapconcat 'car mapped "\\|")
527: "\\)\\>"))
528: (sub-count 2)
529: (sub-list (mapcar
530: (lambda (i)
531: (let ((sub (cons sub-count (nth 2 i))))
532: (setq sub-count (+ sub-count (nth 1 i)))
533: sub
534: ))
535: mapped)))
536: (let ((result (cons regexp sub-list)))
537: (byte-compile 'result)
538: result)))
539:
1.49 dvdkhlng 540: (defun forth-compile-words ()
541: "Compile the the words from `forth-words' and `forth-indent-words' into
542: the format that's later used for doing the actual hilighting/indentation.
1.51 dvdkhlng 543: Store the resulting compiled wordlists in `forth-compiled-words' and
1.49 dvdkhlng 544: `forth-compiled-indent-words', respective"
545: (setq forth-compiled-words
546: (forth-compile-wordlist
547: (forth-filter 'forth-words-filter forth-words)))
548: (setq forth-compiled-indent-words
549: (forth-compile-wordlist forth-indent-words)))
550:
551: (defun forth-hack-local-variables ()
1.51 dvdkhlng 552: "Parse and bind local variables, set in the contents of the current
553: forth-mode buffer. Prepend `forth-local-words' to `forth-words' and
554: `forth-local-indent-words' to `forth-indent-words'."
1.78 dvdkhlng 555: (put 'forth-local-indent-words 'safe-local-variable 'listp)
556: (put 'forth-local-words 'safe-local-variable 'listp)
1.49 dvdkhlng 557: (hack-local-variables)
558: (setq forth-words (append forth-local-words forth-words))
559: (setq forth-indent-words (append forth-local-indent-words
560: forth-indent-words)))
561:
1.51 dvdkhlng 562: (defun forth-customize-words ()
563: "Add the words from `forth-custom-words' and `forth-custom-indent-words'
564: to `forth-words' and `forth-indent-words', respective. Add
565: `forth-objects-words' and/or `forth-oof-words' to `forth-words', if
566: `forth-use-objects' and/or `forth-use-oof', respective is set."
567: (setq forth-words (append forth-custom-words forth-words
568: (if forth-use-oof forth-oof-words nil)
569: (if forth-use-objects forth-objects-words nil)))
570: (setq forth-indent-words (append
571: forth-custom-indent-words forth-indent-words)))
572:
573:
574:
1.48 pazsan 575: ;; get location of first character of previous forth word that's got
576: ;; properties
577: (defun forth-previous-start (pos)
578: (let* ((word (get-text-property pos 'forth-word))
579: (prev (previous-single-property-change
580: (min (point-max) (1+ pos)) 'forth-word
581: (current-buffer) (point-min))))
582: (if (or (= (point-min) prev) word) prev
583: (if (get-text-property (1- prev) 'forth-word)
584: (previous-single-property-change
585: prev 'forth-word (current-buffer) (point-min))
586: (point-min)))))
587:
588: ;; Get location of the last character of the current/next forth word that's
589: ;; got properties, text that's parsed by the word is considered as parts of
590: ;; the word.
591: (defun forth-next-end (pos)
592: (let* ((word (get-text-property pos 'forth-word))
593: (next (next-single-property-change pos 'forth-word
594: (current-buffer) (point-max))))
595: (if word next
596: (if (get-text-property next 'forth-word)
597: (next-single-property-change
598: next 'forth-word (current-buffer) (point-max))
599: (point-max)))))
600:
601: (defun forth-next-whitespace (pos)
602: (save-excursion
603: (goto-char pos)
604: (skip-syntax-forward "-" (point-max))
605: (point)))
606: (defun forth-previous-word (pos)
607: (save-excursion
608: (goto-char pos)
609: (re-search-backward "\\<" pos (point-min) 1)
610: (point)))
611:
612: ;; Delete all properties, used by Forth mode, from `from' to `to'.
613: (defun forth-delete-properties (from to)
614: (remove-text-properties
1.55 dvdkhlng 615: from to '(face nil fontified nil
616: forth-parsed nil forth-word nil forth-state nil)))
1.48 pazsan 617:
618: ;; Get the index of the branch of the most recently evaluated regular
619: ;; expression that matched. (used for identifying branches "a\\|b\\|c...")
620: (defun forth-get-regexp-branch ()
621: (let ((count 2))
1.59 dvdkhlng 622: (while (not (condition-case err (match-beginning count)
623: (args-out-of-range t))) ; XEmacs requires error handling
1.48 pazsan 624: (setq count (1+ count)))
625: count))
626:
627: ;; seek to next forth-word and return its "word-description"
628: (defun forth-next-known-forth-word (to)
629: (if (<= (point) to)
630: (progn
631: (let* ((regexp (car forth-compiled-words))
632: (pos (re-search-forward regexp to t)))
633: (if pos (let ((branch (forth-get-regexp-branch))
634: (descr (cdr forth-compiled-words)))
635: (goto-char (match-beginning 0))
636: (cdr (assoc branch descr)))
637: 'nil)))
638: nil))
639:
640: ;; Set properties of forth word at `point', eventually parsing subsequent
641: ;; words, and parsing all whitespaces. Set point to delimiter after word.
642: ;; The word, including it's parsed text gets the `forth-word' property, whose
643: ;; value is unique, and may be used for getting the word's start/end
644: ;; positions.
645: (defun forth-set-word-properties (state data)
646: (let* ((start (point))
647: (end (progn (re-search-forward "[ \t]\\|$" (point-max) 1)
648: (point)))
649: (type (car data))
650: (hilight (nth 1 data))
651: (bad-word (and (not state) (eq type 'compile-only)))
652: (hlface (if bad-word font-lock-warning-face
653: (if (<= (cdr hilight) forth-hilight-level)
654: (car hilight) nil))))
655: (when hlface (put-text-property start end 'face hlface))
656: ;; if word parses in current state, process parsed range of text
657: (when (or (not state) (eq type 'compile-only) (eq type 'immediate))
658: (let ((parse-data (nthcdr 2 data)))
659: (while parse-data
660: (let ((delim (nth 0 parse-data))
661: (skip-leading (nth 1 parse-data))
662: (parse-type (nth 2 parse-data))
663: (parsed-hilight (nth 3 parse-data))
664: (parse-start (point))
665: (parse-end))
666: (when skip-leading
667: (while (and (looking-at delim) (> (match-end 0) (point))
668: (not (looking-at "\n")))
669: (forward-char)))
670: (re-search-forward delim (point-max) 1)
671: (setq parse-end (point))
672: (forth-delete-properties end parse-end)
673: (when (<= (cdr parsed-hilight) forth-hilight-level)
674: (put-text-property
675: parse-start parse-end 'face (car parsed-hilight)))
676: (put-text-property
677: parse-start parse-end 'forth-parsed parse-type)
678: (setq end parse-end)
679: (setq parse-data (nthcdr 4 parse-data))))))
680: (put-text-property start end 'forth-word start)))
681:
682: ;; Search for known Forth words in the range `from' to `to', using
683: ;; `forth-next-known-forth-word' and set their properties via
684: ;; `forth-set-word-properties'.
1.51 dvdkhlng 685: (defun forth-update-properties (from to &optional loudly)
1.48 pazsan 686: (save-excursion
1.51 dvdkhlng 687: (let ((msg-count 0) (state) (word-descr) (last-location))
1.48 pazsan 688: (goto-char (forth-previous-word (forth-previous-start
689: (max (point-min) (1- from)))))
690: (setq to (forth-next-end (min (point-max) (1+ to))))
691: ;; `to' must be on a space delimiter, if a parsing word was changed
692: (setq to (forth-next-whitespace to))
693: (setq state (get-text-property (point) 'forth-state))
694: (setq last-location (point))
695: (forth-delete-properties (point) to)
1.55 dvdkhlng 696: (put-text-property (point) to 'fontified t)
1.48 pazsan 697: ;; hilight loop...
698: (while (setq word-descr (forth-next-known-forth-word to))
1.51 dvdkhlng 699: (when loudly
700: (when (equal 0 (% msg-count 100))
701: (message "Parsing Forth code...%s"
702: (make-string (/ msg-count 100) ?.)))
703: (setq msg-count (1+ msg-count)))
1.48 pazsan 704: (forth-set-word-properties state word-descr)
705: (when state (put-text-property last-location (point) 'forth-state t))
706: (let ((type (car word-descr)))
707: (if (eq type 'definition-starter) (setq state t))
708: (if (eq type 'definition-ender) (setq state nil))
709: (setq last-location (point))))
710: ;; update state property up to `to'
711: (if (and state (< (point) to))
712: (put-text-property last-location to 'forth-state t))
713: ;; extend search if following state properties differ from current state
714: (if (< to (point-max))
715: (if (not (equal state (get-text-property (1+ to) 'forth-state)))
716: (let ((extend-to (next-single-property-change
717: to 'forth-state (current-buffer) (point-max))))
718: (forth-update-properties to extend-to))
719: ))
720: )))
721:
722: ;; save-buffer-state borrowed from `font-lock.el'
723: (eval-when-compile
724: (defmacro forth-save-buffer-state (varlist &rest body)
725: "Bind variables according to VARLIST and eval BODY restoring buffer state."
1.75 pazsan 726: `(let* (,@(append varlist
1.48 pazsan 727: '((modified (buffer-modified-p)) (buffer-undo-list t)
728: (inhibit-read-only t) (inhibit-point-motion-hooks t)
729: before-change-functions after-change-functions
1.75 pazsan 730: deactivate-mark buffer-file-name buffer-file-truename)))
731: ,@body
1.48 pazsan 732: (when (and (not modified) (buffer-modified-p))
1.75 pazsan 733: (set-buffer-modified-p nil)))))
1.48 pazsan 734:
735: ;; Function that is added to the `change-functions' hook. Calls
736: ;; `forth-update-properties' and keeps care of disabling undo information
737: ;; and stuff like that.
1.51 dvdkhlng 738: (defun forth-change-function (from to len &optional loudly)
1.48 pazsan 739: (save-match-data
1.55 dvdkhlng 740: (forth-save-buffer-state
741: ()
742: (unless forth-disable-parser (forth-update-properties from to loudly))
743: (forth-update-warn-long-lines))))
744:
745: (defun forth-fontification-function (from)
746: "Function to be called from `fontification-functions' of Emacs 21."
747: (save-match-data
748: (forth-save-buffer-state
749: ((to (min (point-max) (+ from 100))))
750: (unless (or forth-disable-parser (not forth-jit-parser)
751: (get-text-property from 'fontified))
752: (forth-update-properties from to)))))
1.48 pazsan 753:
754: (eval-when-compile
755: (byte-compile 'forth-set-word-properties)
756: (byte-compile 'forth-next-known-forth-word)
757: (byte-compile 'forth-update-properties)
758: (byte-compile 'forth-delete-properties)
759: (byte-compile 'forth-get-regexp-branch))
760:
1.51 dvdkhlng 761: ;;; imenu support
762: ;;;
1.52 dvdkhlng 763: (defvar forth-defining-words
764: '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT"
765: "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"
1.83 dvdkhlng 766: "DEFER" "ALIAS" "interpret/compile:")
1.53 dvdkhlng 767: "List of words, that define the following word.
1.55 dvdkhlng 768: Used for imenu index generation.")
1.52 dvdkhlng 769:
1.57 dvdkhlng 770: (defvar forth-defining-words-regexp nil
771: "Regexp that's generated for matching `forth-defining-words'")
1.52 dvdkhlng 772:
1.51 dvdkhlng 773: (defun forth-next-definition-starter ()
774: (progn
1.52 dvdkhlng 775: (let* ((pos (re-search-forward forth-defining-words-regexp (point-max) t)))
1.51 dvdkhlng 776: (if pos
777: (if (or (text-property-not-all (match-beginning 0) (match-end 0)
1.52 dvdkhlng 778: 'forth-parsed nil)
779: (text-property-not-all (match-beginning 0) (match-end 0)
780: 'forth-state nil))
1.51 dvdkhlng 781: (forth-next-definition-starter)
782: t)
783: nil))))
784:
785: (defun forth-create-index ()
1.52 dvdkhlng 786: (let* ((forth-defining-words-regexp
787: (concat "\\<\\(" (regexp-opt forth-defining-words) "\\)\\>"))
1.51 dvdkhlng 788: (index nil))
789: (goto-char (point-min))
790: (while (forth-next-definition-starter)
791: (if (looking-at "[ \t]*\\([^ \t\n]+\\)")
792: (setq index (cons (cons (match-string 1) (point)) index))))
793: index))
794:
1.57 dvdkhlng 795: ;; top-level require is executed at byte-compile and load time
1.58 dvdkhlng 796: (eval-and-compile (forth-require 'speedbar))
1.57 dvdkhlng 797:
798: ;; this code is executed at load-time only
1.58 dvdkhlng 799: (when (memq 'speedbar features)
1.57 dvdkhlng 800: (speedbar-add-supported-extension ".fs")
801: (speedbar-add-supported-extension ".fb"))
1.51 dvdkhlng 802:
1.48 pazsan 803: ;; (require 'profile)
804: ;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch))
805:
806: ;;; Indentation
807: ;;;
808:
809: ;; Return, whether `pos' is the first forth word on its line
810: (defun forth-first-word-on-line-p (pos)
811: (save-excursion
812: (beginning-of-line)
813: (skip-chars-forward " \t")
814: (= pos (point))))
815:
816: ;; Return indentation data (SELF-INDENT . NEXT-INDENT) of next known
817: ;; indentation word, or nil if there is no word up to `to'.
818: ;; Position `point' at location just after found word, or at `to'. Parsed
819: ;; ranges of text will not be taken into consideration!
820: (defun forth-next-known-indent-word (to)
821: (if (<= (point) to)
822: (progn
823: (let* ((regexp (car forth-compiled-indent-words))
824: (pos (re-search-forward regexp to t)))
825: (if pos
1.54 dvdkhlng 826: (let* ((start (match-beginning 0))
827: (end (match-end 0))
828: (branch (forth-get-regexp-branch))
829: (descr (cdr forth-compiled-indent-words))
830: (indent (cdr (assoc branch descr)))
831: (type (nth 2 indent)))
832: ;; skip words that are parsed (strings/comments) and
833: ;; non-immediate words inside definitions
834: (if (or (text-property-not-all start end 'forth-parsed nil)
835: (and (eq type 'non-immediate)
836: (text-property-not-all start end
837: 'forth-state nil)))
838: (forth-next-known-indent-word to)
1.48 pazsan 839: (if (forth-first-word-on-line-p (match-beginning 0))
840: (nth 0 indent) (nth 1 indent))))
841: nil)))
842: nil))
843:
844: ;; Translate indentation value `indent' to indentation column. Multiples of
845: ;; 2 correspond to multiples of `forth-indent-level'. Odd numbers get an
846: ;; additional `forth-minor-indent-level' added (or substracted).
847: (defun forth-convert-to-column (indent)
848: (let* ((sign (if (< indent 0) -1 1))
849: (value (abs indent))
850: (major (* (/ value 2) forth-indent-level))
851: (minor (* (% value 2) forth-minor-indent-level)))
852: (* sign (+ major minor))))
853:
854: ;; Return the column increment, that the current line of forth code does to
855: ;; the current or following lines. `which' specifies which indentation values
1.70 dvdkhlng 856: ;; to use. 1 means the indentation of following lines relative to current
857: ;; line, 0 means the indentation of the current line relative to the previous
1.48 pazsan 858: ;; line. Return `nil', if there are no indentation words on the current line.
859: (defun forth-get-column-incr (which)
860: (save-excursion
861: (let ((regexp (car forth-compiled-indent-words))
862: (word-indent)
863: (self-indent nil)
864: (next-indent nil)
865: (to (save-excursion (end-of-line) (point))))
866: (beginning-of-line)
867: (while (setq word-indent (forth-next-known-indent-word to))
868: (let* ((self-incr (car word-indent))
869: (next-incr (cdr word-indent))
870: (self-column-incr (forth-convert-to-column self-incr))
871: (next-column-incr (forth-convert-to-column next-incr)))
872: (setq next-indent (if next-indent next-indent 0))
873: (setq self-indent (if self-indent self-indent 0))
874: (if (or (and (> next-indent 0) (< self-column-incr 0))
875: (and (< next-indent 0) (> self-column-incr 0)))
876: (setq next-indent (+ next-indent self-column-incr))
877: (setq self-indent (+ self-indent self-column-incr)))
878: (setq next-indent (+ next-indent next-column-incr))))
879: (nth which (list self-indent next-indent)))))
880:
881: ;; Find previous line that contains indentation words, return the column,
882: ;; to which following text should be indented to.
883: (defun forth-get-anchor-column ()
884: (save-excursion
885: (if (/= 0 (forward-line -1)) 0
1.54 dvdkhlng 886: (let ((indent))
1.48 pazsan 887: (while (not (or (setq indent (forth-get-column-incr 1))
888: (<= (point) (point-min))))
889: (forward-line -1))
890: (+ (current-indentation) (if indent indent 0))))))
891:
892: (defun forth-indent-line (&optional flag)
893: "Correct indentation of the current Forth line."
894: (let* ((anchor (forth-get-anchor-column))
895: (column-incr (forth-get-column-incr 0)))
896: (forth-indent-to (if column-incr (+ anchor column-incr) anchor))))
897:
1.49 dvdkhlng 898: (defun forth-current-column ()
899: (- (point) (save-excursion (beginning-of-line) (point))))
900: (defun forth-current-indentation ()
901: (- (save-excursion (beginning-of-line) (forward-to-indentation 0) (point))
902: (save-excursion (beginning-of-line) (point))))
903:
1.48 pazsan 904: (defun forth-indent-to (x)
905: (let ((p nil))
1.49 dvdkhlng 906: (setq p (- (forth-current-column) (forth-current-indentation)))
1.48 pazsan 907: (forth-delete-indentation)
908: (beginning-of-line)
909: (indent-to x)
910: (if (> p 0) (forward-char p))))
911:
912: (defun forth-delete-indentation ()
913: (save-excursion
914: (delete-region
915: (progn (beginning-of-line) (point))
916: (progn (back-to-indentation) (point)))))
917:
918: (defun forth-indent-command ()
919: (interactive)
920: (forth-indent-line t))
921:
922: ;; remove trailing whitespaces in current line
923: (defun forth-remove-trailing ()
924: (save-excursion
925: (end-of-line)
926: (delete-region (point) (progn (skip-chars-backward " \t") (point)))))
927:
928: ;; insert newline, removing any trailing whitespaces in the current line
929: (defun forth-newline-remove-trailing ()
930: (save-excursion
1.49 dvdkhlng 931: (delete-region (point) (progn (skip-chars-backward " \t") (point))))
932: (newline))
933: ; (let ((was-point (point-marker)))
934: ; (unwind-protect
935: ; (progn (forward-line -1) (forth-remove-trailing))
936: ; (goto-char (was-point)))))
1.48 pazsan 937:
938: ;; workaround for bug in `reindent-then-newline-and-indent'
939: (defun forth-reindent-then-newline-and-indent ()
940: (interactive "*")
941: (indent-according-to-mode)
942: (forth-newline-remove-trailing)
943: (indent-according-to-mode))
944:
945:
946: ;;; Block file encoding/decoding (dk)
947: ;;;
948:
949: (defconst forth-c/l 64 "Number of characters per block line")
950: (defconst forth-l/b 16 "Number of lines per block")
951:
952: ;; Check whether the unconverted block file line, point is in, does not
953: ;; contain `\n' and `\t' characters.
954: (defun forth-check-block-line (line)
955: (let ((end (save-excursion (beginning-of-line) (forward-char forth-c/l)
956: (point))))
957: (save-excursion
958: (beginning-of-line)
959: (when (search-forward "\n" end t)
960: (message "Warning: line %i contains newline character #10" line)
961: (ding t))
962: (beginning-of-line)
963: (when (search-forward "\t" end t)
964: (message "Warning: line %i contains tab character #8" line)
965: (ding t)))))
966:
967: (defun forth-convert-from-block (from to)
968: "Convert block file format to stream source in current buffer."
969: (let ((line (count-lines (point-min) from)))
970: (save-excursion
971: (goto-char from)
972: (set-mark to)
973: (while (< (+ (point) forth-c/l) (mark t))
974: (setq line (1+ line))
975: (forth-check-block-line line)
976: (forward-char forth-c/l)
977: (forth-newline-remove-trailing))
978: (when (= (+ (point) forth-c/l) (mark t))
979: (forth-remove-trailing))
980: (mark t))))
981:
982: ;; Pad a line of a block file up to `forth-c/l' characters, positioning `point'
983: ;; at the end of line.
984: (defun forth-pad-block-line ()
985: (save-excursion
986: (end-of-line)
987: (if (<= (current-column) forth-c/l)
988: (move-to-column forth-c/l t)
989: (message "Line %i longer than %i characters, truncated"
990: (count-lines (point-min) (point)) forth-c/l)
991: (ding t)
992: (move-to-column forth-c/l t)
993: (delete-region (point) (progn (end-of-line) (point))))))
994:
995: ;; Replace tab characters in current line by spaces.
996: (defun forth-convert-tabs-in-line ()
997: (save-excursion
998: (beginning-of-line)
999: (while (search-forward "\t" (save-excursion (end-of-line) (point)) t)
1000: (backward-char)
1001: (delete-region (point) (1+ (point)))
1002: (insert-char ?\ (- tab-width (% (current-column) tab-width))))))
1003:
1004: ;; Delete newline at end of current line, concatenating it with the following
1005: ;; line. Place `point' at end of newly formed line.
1006: (defun forth-delete-newline ()
1007: (end-of-line)
1008: (delete-region (point) (progn (beginning-of-line 2) (point))))
1009:
1010: (defun forth-convert-to-block (from to &optional original-buffer)
1011: "Convert range of text to block file format in current buffer."
1012: (let* ((lines 0)) ; I have to count lines myself, since `count-lines' has
1013: ; problems with trailing newlines...
1014: (save-excursion
1015: (goto-char from)
1016: (set-mark to)
1017: ;; pad lines to full length (`forth-c/l' characters per line)
1018: (while (< (save-excursion (end-of-line) (point)) (mark t))
1019: (setq lines (1+ lines))
1020: (forth-pad-block-line)
1021: (forth-convert-tabs-in-line)
1022: (forward-line))
1023: ;; also make sure the last line is padded, if `to' is at its end
1024: (end-of-line)
1025: (when (= (point) (mark t))
1026: (setq lines (1+ lines))
1027: (forth-pad-block-line)
1028: (forth-convert-tabs-in-line))
1029: ;; remove newlines between lines
1030: (goto-char from)
1031: (while (< (save-excursion (end-of-line) (point)) (mark t))
1032: (forth-delete-newline))
1033: ;; append empty lines, until last block is complete
1034: (goto-char (mark t))
1035: (let* ((required (* (/ (+ lines (1- forth-l/b)) forth-l/b) forth-l/b))
1036: (pad-lines (- required lines)))
1037: (while (> pad-lines 0)
1038: (insert-char ?\ forth-c/l)
1039: (setq pad-lines (1- pad-lines))))
1040: (point))))
1041:
1042: (defun forth-detect-block-file-p ()
1043: "Return non-nil if the current buffer is in block file format. Detection is
1044: done by checking whether the first line has 1024 characters or more."
1045: (save-restriction
1046: (widen)
1047: (save-excursion
1.54 dvdkhlng 1048: (goto-char (point-min))
1.48 pazsan 1049: (end-of-line)
1050: (>= (current-column) 1024))))
1051:
1052: ;; add block file conversion routines to `format-alist'
1053: (defconst forth-block-format-description
1054: '(forth-blocks "Forth block source file" nil
1055: forth-convert-from-block forth-convert-to-block
1056: t normal-mode))
1057: (unless (memq forth-block-format-description format-alist)
1058: (setq format-alist (cons forth-block-format-description format-alist)))
1059:
1060: ;;; End block file encoding/decoding
1061:
1062: ;;; Block file editing
1063: ;;;
1064: (defvar forth-overlay-arrow-string ">>")
1065: (defvar forth-block-base 1 "Number of first block in block file")
1066: (defvar forth-show-screen nil
1067: "Non-nil means to show screen starts and numbers (for block files)")
1068: (defvar forth-warn-long-lines nil
1069: "Non-nil means to warn about lines that are longer than 64 characters")
1070:
1071: (defvar forth-screen-marker nil)
1.57 dvdkhlng 1072: (defvar forth-screen-number-string nil)
1.48 pazsan 1073:
1074: (defun forth-update-show-screen ()
1075: "If `forth-show-screen' is non-nil, put overlay arrow to start of screen,
1076: `point' is in. If arrow now points to different screen than before, display
1077: screen number."
1078: (if (not forth-show-screen)
1079: (setq overlay-arrow-string nil)
1080: (save-excursion
1081: (let* ((line (count-lines (point-min) (min (point-max) (1+ (point)))))
1082: (first-line (1+ (* (/ (1- line) forth-l/b) forth-l/b)))
1083: (scr (+ forth-block-base (/ first-line forth-l/b))))
1084: (setq overlay-arrow-string forth-overlay-arrow-string)
1085: (goto-line first-line)
1086: (setq overlay-arrow-position forth-screen-marker)
1.50 dvdkhlng 1087: (set-marker forth-screen-marker
1088: (save-excursion (goto-line first-line) (point)))
1089: (setq forth-screen-number-string (format "%d" scr))))))
1.48 pazsan 1090:
1091: (add-hook 'forth-motion-hooks 'forth-update-show-screen)
1092:
1093: (defun forth-update-warn-long-lines ()
1094: "If `forth-warn-long-lines' is non-nil, display a warning whenever a line
1095: exceeds 64 characters."
1096: (when forth-warn-long-lines
1097: (when (> (save-excursion (end-of-line) (current-column)) forth-c/l)
1098: (message "Warning: current line exceeds %i characters"
1099: forth-c/l))))
1100:
1101: (add-hook 'forth-motion-hooks 'forth-update-warn-long-lines)
1.55 dvdkhlng 1102:
1.48 pazsan 1103: ;;; End block file editing
1.1 anton 1104:
1.6 anton 1105:
1.1 anton 1106: (defvar forth-mode-abbrev-table nil
1107: "Abbrev table in use in Forth-mode buffers.")
1108:
1109: (define-abbrev-table 'forth-mode-abbrev-table ())
1110:
1111: (defvar forth-mode-map nil
1112: "Keymap used in Forth mode.")
1113:
1114: (if (not forth-mode-map)
1115: (setq forth-mode-map (make-sparse-keymap)))
1116:
1.9 anton 1117: ;(define-key forth-mode-map "\M-\C-x" 'compile)
1.7 anton 1118: (define-key forth-mode-map "\C-x\\" 'comment-region)
1119: (define-key forth-mode-map "\C-x~" 'forth-remove-tracers)
1.1 anton 1120: (define-key forth-mode-map "\C-x\C-m" 'forth-split)
1121: (define-key forth-mode-map "\t" 'forth-indent-command)
1.48 pazsan 1122: (define-key forth-mode-map "\C-m" 'forth-reindent-then-newline-and-indent)
1.7 anton 1123: (define-key forth-mode-map "\M-q" 'forth-fill-paragraph)
1.13 pazsan 1124: (define-key forth-mode-map "\e." 'forth-find-tag)
1.1 anton 1125:
1.61 dvdkhlng 1126: ;; setup for C-h C-i to work
1.58 dvdkhlng 1127: (eval-and-compile (forth-require 'info-look))
1128: (when (memq 'info-look features)
1.61 dvdkhlng 1129: (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t
1.59 dvdkhlng 1130: (("(gforth)Word Index"))
1.61 dvdkhlng 1131: "\\S-+")))
1.59 dvdkhlng 1132: (unless (memq forth-info-lookup info-lookup-alist)
1.61 dvdkhlng 1133: (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist)))
1134: ;; in X-Emacs C-h C-i is by default bound to Info-query
1.69 dvdkhlng 1135: (define-key forth-mode-map [?\C-h ?\C-i] 'info-lookup-symbol))
1.59 dvdkhlng 1136:
1137: ;; (info-lookup-add-help
1138: ;; :topic 'symbol
1139: ;; :mode 'forth-mode
1140: ;; :regexp "[^
1141: ;; ]+"
1142: ;; :ignore-case t
1143: ;; :doc-spec '(("(gforth)Name Index" nil "`" "' "))))
1.35 anton 1144:
1.57 dvdkhlng 1145: (require 'etags)
1.13 pazsan 1146:
1147: (defun forth-find-tag (tagname &optional next-p regexp-p)
1148: (interactive (find-tag-interactive "Find tag: "))
1.53 dvdkhlng 1149: (unless (or regexp-p next-p)
1.67 dvdkhlng 1150: (setq tagname (concat "\\(^\\|\\s-+\\)\\(" (regexp-quote tagname)
1151: "\\)\\s-*\x7f")))
1.13 pazsan 1152: (switch-to-buffer
1.53 dvdkhlng 1153: (find-tag-noselect tagname next-p t)))
1.13 pazsan 1154:
1.1 anton 1155: (defvar forth-mode-syntax-table nil
1156: "Syntax table in use in Forth-mode buffers.")
1157:
1.48 pazsan 1158: ;; Important: hilighting/indentation now depends on a correct syntax table.
1159: ;; All characters, except whitespace *must* belong to the "word constituent"
1160: ;; syntax class. If different behaviour is required, use of Categories might
1161: ;; help.
1162: (if (not forth-mode-syntax-table)
1.1 anton 1163: (progn
1164: (setq forth-mode-syntax-table (make-syntax-table))
1.6 anton 1165: (let ((char 0))
1166: (while (< char ?!)
1167: (modify-syntax-entry char " " forth-mode-syntax-table)
1168: (setq char (1+ char)))
1169: (while (< char 256)
1170: (modify-syntax-entry char "w" forth-mode-syntax-table)
1171: (setq char (1+ char))))
1172: ))
1.1 anton 1173:
1174: (defun forth-mode-variables ()
1175: (set-syntax-table forth-mode-syntax-table)
1176: (setq local-abbrev-table forth-mode-abbrev-table)
1177: (make-local-variable 'paragraph-start)
1178: (setq paragraph-start (concat "^$\\|" page-delimiter))
1179: (make-local-variable 'paragraph-separate)
1180: (setq paragraph-separate paragraph-start)
1181: (make-local-variable 'indent-line-function)
1182: (setq indent-line-function 'forth-indent-line)
1.6 anton 1183: ; (make-local-variable 'require-final-newline)
1184: ; (setq require-final-newline t)
1.1 anton 1185: (make-local-variable 'comment-start)
1.3 anton 1186: (setq comment-start "\\ ")
1187: ;(make-local-variable 'comment-end)
1188: ;(setq comment-end " )")
1.1 anton 1189: (make-local-variable 'comment-column)
1190: (setq comment-column 40)
1191: (make-local-variable 'comment-start-skip)
1.65 dvdkhlng 1192: (setq comment-start-skip "\\\\ ")
1.57 dvdkhlng 1193: (make-local-variable 'comment-indent-function)
1194: (setq comment-indent-function 'forth-comment-indent)
1.1 anton 1195: (make-local-variable 'parse-sexp-ignore-comments)
1.47 pazsan 1196: (setq parse-sexp-ignore-comments t)
1.48 pazsan 1197: (setq case-fold-search t)
1.55 dvdkhlng 1198: (make-local-variable 'forth-was-point)
1199: (setq forth-was-point -1)
1.48 pazsan 1200: (make-local-variable 'forth-words)
1201: (make-local-variable 'forth-compiled-words)
1202: (make-local-variable 'forth-compiled-indent-words)
1203: (make-local-variable 'forth-hilight-level)
1204: (make-local-variable 'after-change-functions)
1205: (make-local-variable 'forth-show-screen)
1206: (make-local-variable 'forth-screen-marker)
1207: (make-local-variable 'forth-warn-long-lines)
1.50 dvdkhlng 1208: (make-local-variable 'forth-screen-number-string)
1.51 dvdkhlng 1209: (make-local-variable 'forth-use-oof)
1210: (make-local-variable 'forth-use-objects)
1.48 pazsan 1211: (setq forth-screen-marker (copy-marker 0))
1.51 dvdkhlng 1212: (add-hook 'after-change-functions 'forth-change-function)
1.62 dvdkhlng 1213: (if (and forth-jit-parser (>= emacs-major-version 21))
1.55 dvdkhlng 1214: (add-hook 'fontification-functions 'forth-fontification-function))
1.51 dvdkhlng 1215: (setq imenu-create-index-function 'forth-create-index))
1.47 pazsan 1216:
1.2 anton 1217: ;;;###autoload
1.1 anton 1218: (defun forth-mode ()
1219: "
1220: Major mode for editing Forth code. Tab indents for Forth code. Comments
1.9 anton 1221: are delimited with \\ and newline. Paragraphs are separated by blank lines
1.49 dvdkhlng 1222: only. Block files are autodetected, when read, and converted to normal
1223: stream source format. See also `forth-block-mode'.
1.1 anton 1224: \\{forth-mode-map}
1225:
1.48 pazsan 1226: Variables controlling syntax hilighting/recognition of parsed text:
1227: `forth-words'
1228: List of words that have a special parsing behaviour and/or should be
1.51 dvdkhlng 1229: hilighted. Add custom words by setting forth-custom-words in your
1230: .emacs, or by setting forth-local-words, in source-files' local
1231: variables lists.
1232: forth-use-objects
1.55 dvdkhlng 1233: Set this variable to non-nil in your .emacs, or in a local variables
1.51 dvdkhlng 1234: list, to hilight and recognize the words from the \"Objects\" package
1235: for object-oriented programming.
1236: forth-use-oof
1237: Same as above, just for the \"OOF\" package.
1238: forth-custom-words
1239: List of custom Forth words to prepend to `forth-words'. Should be set
1240: in your .emacs.
1.49 dvdkhlng 1241: forth-local-words
1242: List of words to prepend to `forth-words', whenever a forth-mode
1243: buffer is created. That variable should be set by Forth sources, using
1244: a local variables list at the end of file, to get file-specific
1245: hilighting.
1246: 0 [IF]
1247: Local Variables: ...
1248: forth-local-words: ...
1249: End:
1250: [THEN]
1.48 pazsan 1251: forth-hilight-level
1252: Controls how much syntax hilighting is done. Should be in the range
1.51 dvdkhlng 1253: 0..3
1.48 pazsan 1254:
1.1 anton 1255: Variables controlling indentation style:
1.48 pazsan 1256: `forth-indent-words'
1257: List of words that influence indentation.
1.51 dvdkhlng 1258: forth-local-indent-words
1.49 dvdkhlng 1259: List of words to prepend to `forth-indent-words', similar to
1.51 dvdkhlng 1260: forth-local-words. Should be used for specifying file-specific
1.49 dvdkhlng 1261: indentation, using a local variables list.
1.51 dvdkhlng 1262: forth-custom-indent-words
1263: List of words to prepend to `forth-indent-words'. Should be set in your
1264: .emacs.
1.1 anton 1265: forth-indent-level
1266: Indentation increment/decrement of Forth statements.
1.48 pazsan 1267: forth-minor-indent-level
1268: Minor indentation increment/decrement of Forth statemens.
1.1 anton 1269:
1.48 pazsan 1270: Variables controlling block-file editing:
1.51 dvdkhlng 1271: forth-show-screen
1.48 pazsan 1272: Non-nil means, that the start of the current screen is marked by an
1.50 dvdkhlng 1273: overlay arrow, and screen numbers are displayed in the mode line.
1274: This variable is by default nil for `forth-mode' and t for
1275: `forth-block-mode'.
1.51 dvdkhlng 1276: forth-overlay-arrow-string
1.48 pazsan 1277: String to display as the overlay arrow, when `forth-show-screen' is t.
1278: Setting this variable to nil disables the overlay arrow.
1.51 dvdkhlng 1279: forth-block-base
1.48 pazsan 1280: Screen number of the first block in a block file. Defaults to 1.
1.51 dvdkhlng 1281: forth-warn-long-lines
1.48 pazsan 1282: Non-nil means that a warning message is displayed whenever you edit or
1283: move over a line that is longer than 64 characters (the maximum line
1284: length that can be stored into a block file). This variable defaults to
1285: t for `forth-block-mode' and to nil for `forth-mode'.
1.1 anton 1286:
1.66 dvdkhlng 1287: Variables controlling interaction with the Forth-process (also see
1288: `run-forth'):
1289: forth-program-name
1290: Program invoked by the `run-forth' command (including arguments).
1291: inferior-forth-mode-hook
1292: Hook for customising inferior-forth-mode.
1293: forth-compile-command
1294: Default command to execute on `compile'.
1295: "
1.1 anton 1296: (interactive)
1297: (kill-all-local-variables)
1298: (use-local-map forth-mode-map)
1299: (setq mode-name "Forth")
1300: (setq major-mode 'forth-mode)
1.62 dvdkhlng 1301: (forth-install-motion-hook)
1.48 pazsan 1302: ;; convert buffer contents from block file format, if necessary
1303: (when (forth-detect-block-file-p)
1304: (widen)
1305: (message "Converting from Forth block source...")
1306: (forth-convert-from-block (point-min) (point-max))
1307: (message "Converting from Forth block source...done"))
1308: ;; if user switched from forth-block-mode to forth-mode, make sure the file
1309: ;; is now stored as normal strem source
1310: (when (equal buffer-file-format '(forth-blocks))
1311: (setq buffer-file-format nil))
1.1 anton 1312: (forth-mode-variables)
1313: ; (if (not (forth-process-running-p))
1314: ; (run-forth forth-program-name))
1.49 dvdkhlng 1315: (run-hooks 'forth-mode-hook))
1.48 pazsan 1316:
1.50 dvdkhlng 1317: ;;;###autoload
1.48 pazsan 1318: (define-derived-mode forth-block-mode forth-mode "Forth Block Source"
1319: "Major mode for editing Forth block source files, derived from
1320: `forth-mode'. Differences to `forth-mode' are:
1321: * files are converted to block format, when written (`buffer-file-format'
1322: is set to `(forth-blocks)')
1323: * `forth-show-screen' and `forth-warn-long-lines' are t by default
1324:
1325: Note that the length of lines in block files is limited to 64 characters.
1326: When writing longer lines to a block file, a warning is displayed in the
1327: echo area and the line is truncated.
1328:
1329: Another problem is imposed by block files that contain newline or tab
1330: characters. When Emacs converts such files back to block file format,
1.50 dvdkhlng 1331: it'll translate those characters to a number of spaces. However, when
1.48 pazsan 1332: you read such a file, a warning message is displayed in the echo area,
1333: including a line number that may help you to locate and fix the problem.
1334:
1335: So have a look at the *Messages* buffer, whenever you hear (or see) Emacs'
1336: bell during block file read/write operations."
1337: (setq buffer-file-format '(forth-blocks))
1338: (setq forth-show-screen t)
1.50 dvdkhlng 1339: (setq forth-warn-long-lines t)
1340: (setq forth-screen-number-string (format "%d" forth-block-base))
1341: (setq mode-line-format (append (reverse (cdr (reverse mode-line-format)))
1342: '("--S" forth-screen-number-string "-%-"))))
1.1 anton 1343:
1.44 anton 1344: (add-hook 'forth-mode-hook
1.9 anton 1345: '(lambda ()
1346: (make-local-variable 'compile-command)
1.49 dvdkhlng 1347: (setq compile-command "gforth ")
1348: (forth-hack-local-variables)
1.51 dvdkhlng 1349: (forth-customize-words)
1.49 dvdkhlng 1350: (forth-compile-words)
1.55 dvdkhlng 1351: (unless (and forth-jit-parser (>= emacs-major-version 21))
1352: (forth-change-function (point-min) (point-max) nil t))))
1.6 anton 1353:
1.7 anton 1354: (defun forth-fill-paragraph ()
1355: "Fill comments (starting with '\'; do not fill code (block style
1356: programmers who tend to fill code won't use emacs anyway:-)."
1.9 anton 1357: ; Currently only comments at the start of the line are filled.
1358: ; Something like lisp-fill-paragraph may be better. We cannot use
1359: ; fill-paragraph, because it removes the \ from the first comment
1360: ; line. Therefore we have to look for the first line of the comment
1361: ; and use fill-region.
1.7 anton 1362: (interactive)
1363: (save-excursion
1364: (beginning-of-line)
1.9 anton 1365: (while (and
1366: (= (forward-line -1) 0)
1.14 anton 1367: (looking-at "[ \t]*\\\\g?[ \t]+")))
1368: (if (not (looking-at "[ \t]*\\\\g?[ \t]+"))
1.9 anton 1369: (forward-line 1))
1370: (let ((from (point))
1371: (to (save-excursion (forward-paragraph) (point))))
1.14 anton 1372: (if (looking-at "[ \t]*\\\\g?[ \t]+")
1.9 anton 1373: (progn (goto-char (match-end 0))
1374: (set-fill-prefix)
1375: (fill-region from to nil))))))
1.7 anton 1376:
1.1 anton 1377: (defun forth-comment-indent ()
1378: (save-excursion
1379: (beginning-of-line)
1380: (if (looking-at ":[ \t]*")
1381: (progn
1382: (end-of-line)
1383: (skip-chars-backward " \t\n")
1384: (1+ (current-column)))
1385: comment-column)))
1386:
1387:
1388: ;; Forth commands
1389:
1.7 anton 1390: (defun forth-remove-tracers ()
1391: "Remove tracers of the form `~~ '. Queries the user for each occurrence."
1392: (interactive)
1.85 dvdkhlng 1393: (query-replace-regexp "\\(~~[ \t]\\|[ \t]~~$\\)" "" nil))
1.7 anton 1394:
1.66 dvdkhlng 1395: (define-key forth-mode-map "\C-x\C-e" 'compile)
1396: (define-key forth-mode-map "\C-x\C-n" 'next-error)
1397: (require 'compile)
1.1 anton 1398:
1.66 dvdkhlng 1399: (defvar forth-compile-command "gforth ")
1400: ;(defvar forth-compilation-window-percent-height 30)
1.1 anton 1401:
1402: (defun forth-split ()
1403: (interactive)
1404: (forth-split-1 "*forth*"))
1405:
1406: (defun forth-split-1 (buffer)
1407: (if (not (eq (window-buffer) (get-buffer buffer)))
1408: (progn
1409: (delete-other-windows)
1410: (split-window-vertically
1.75 pazsan 1411: (/ (frame-height) 2))
1.1 anton 1412: (other-window 1)
1413: (switch-to-buffer buffer)
1414: (goto-char (point-max))
1415: (other-window 1))))
1416:
1.12 pazsan 1417: ;;; Forth menu
1418: ;;; Mikael Karlsson <qramika@eras70.ericsson.se>
1419:
1.61 dvdkhlng 1420: ;; (dk) code commented out due to complaints of XEmacs users. After
1421: ;; all, there's imenu/speedbar, which uses much smarter scanning
1422: ;; rules.
1423:
1424: ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version)
1425: ;; (require 'func-menu)
1426:
1427: ;; (defconst fume-function-name-regexp-forth
1428: ;; "^\\(:\\)[ \t]+\\([^ \t]*\\)"
1429: ;; "Expression to get word definitions in Forth.")
1430:
1431: ;; (setq fume-function-name-regexp-alist
1432: ;; (append '((forth-mode . fume-function-name-regexp-forth)
1433: ;; ) fume-function-name-regexp-alist))
1434:
1435: ;; ;; Find next forth word in the buffer
1436: ;; (defun fume-find-next-forth-function-name (buffer)
1437: ;; "Searches for the next forth word in BUFFER."
1438: ;; (set-buffer buffer)
1439: ;; (if (re-search-forward fume-function-name-regexp nil t)
1440: ;; (let ((beg (match-beginning 2))
1441: ;; (end (match-end 2)))
1442: ;; (cons (buffer-substring beg end) beg))))
1.12 pazsan 1443:
1.61 dvdkhlng 1444: ;; (setq fume-find-function-name-method-alist
1445: ;; (append '((forth-mode . fume-find-next-forth-function-name))))
1.12 pazsan 1446:
1.61 dvdkhlng 1447: ;; ))
1.12 pazsan 1448: ;;; End Forth menu
1449:
1450: ;;; File folding of forth-files
1451: ;;; uses outline
1452: ;;; Toggle activation with M-x fold-f (when editing a forth-file)
1453: ;;; Use f9 to expand, f10 to hide, Or the menubar in xemacs
1454: ;;;
1455: ;;; Works most of the times but loses sync with the cursor occasionally
1456: ;;; Could be improved by also folding on comments
1457:
1.61 dvdkhlng 1458: ;; (dk) This code needs a rewrite; just too ugly and doesn't use the
1459: ;; newer and smarter scanning rules of `imenu'. Who needs it anyway??
1.12 pazsan 1460:
1.61 dvdkhlng 1461: ;; (require 'outline)
1462:
1463: ;; (defun f-outline-level ()
1464: ;; (cond ((looking-at "\\`\\\\")
1465: ;; 0)
1466: ;; ((looking-at "\\\\ SEC")
1467: ;; 0)
1468: ;; ((looking-at "\\\\ \\\\ .*")
1469: ;; 0)
1470: ;; ((looking-at "\\\\ DEFS")
1471: ;; 1)
1472: ;; ((looking-at "\\/\\* ")
1473: ;; 1)
1474: ;; ((looking-at ": .*")
1475: ;; 1)
1476: ;; ((looking-at "\\\\G")
1477: ;; 2)
1478: ;; ((looking-at "[ \t]+\\\\")
1479: ;; 3)))
1.57 dvdkhlng 1480:
1.61 dvdkhlng 1481: ;; (defun fold-f ()
1482: ;; (interactive)
1483: ;; (add-hook 'outline-minor-mode-hook 'hide-body)
1484:
1485: ;; ; outline mode header start, i.e. find word definitions
1486: ;; ;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)")
1487: ;; (setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*")
1488: ;; (setq outline-level 'f-outline-level)
1489:
1490: ;; (outline-minor-mode)
1491: ;; (define-key outline-minor-mode-map '(shift up) 'hide-sublevels)
1492: ;; (define-key outline-minor-mode-map '(shift right) 'show-children)
1493: ;; (define-key outline-minor-mode-map '(shift left) 'hide-subtree)
1494: ;; (define-key outline-minor-mode-map '(shift down) 'show-subtree))
1495:
1.29 pazsan 1496:
1497: ;;(define-key global-map '(shift up) 'fold-f)
1498:
1.12 pazsan 1499: ;;; end file folding
1500:
1501: ;;; func-menu is a package that scans your source file for function definitions
1502: ;;; and makes a menubar entry that lets you jump to any particular function
1503: ;;; definition by selecting it from the menu. The following code turns this on
1504: ;;; for all of the recognized languages. Scanning the buffer takes some time,
1505: ;;; but not much.
1506: ;;;
1.61 dvdkhlng 1507: ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version)
1508: ;; (require 'func-menu)
1509: ;; ;; (define-key global-map 'f8 'function-menu)
1510: ;; (add-hook 'find-fible-hooks 'fume-add-menubar-entry)
1511: ;; ; (define-key global-map "\C-cg" 'fume-prompt-function-goto)
1512: ;; ; (define-key global-map '(shift button3) 'mouse-function-menu)
1513: ;; ))
1.66 dvdkhlng 1514:
1515: ;;;
1516: ;;; Inferior Forth interpreter
1517: ;;; -- mostly copied from `cmuscheme.el' of Emacs 21.2
1518: ;;;
1519:
1520: (eval-and-compile (forth-require 'comint))
1521:
1522: (when (memq 'comint features)
1523:
1524: (defvar forth-program-name "gforth"
1525: "*Program invoked by the `run-forth' command, including program arguments")
1526:
1527: (defcustom inferior-forth-mode-hook nil
1528: "*Hook for customising inferior-forth-mode."
1529: :type 'hook
1530: :group 'forth)
1531:
1532: (defvar inferior-forth-mode-map
1533: (let ((m (make-sparse-keymap)))
1534: (define-key m "\r" 'comint-send-input)
1535: (define-key m "\M-\C-x" 'forth-send-paragraph-and-go)
1536: (define-key m "\C-c\C-l" 'forth-load-file)
1537: m))
1538: ;; Install the process communication commands in the forth-mode keymap.
1539: (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph-and-go)
1540: (define-key forth-mode-map "\eo" 'forth-send-buffer-and-go)
1541:
1542: (define-key forth-mode-map "\M-\C-x" 'forth-send-paragraph-and-go)
1543: (define-key forth-mode-map "\C-c\C-r" 'forth-send-region)
1544: (define-key forth-mode-map "\C-c\M-r" 'forth-send-region-and-go)
1545: (define-key forth-mode-map "\C-c\C-z" 'forth-switch-to-interactive)
1546: (define-key forth-mode-map "\C-c\C-l" 'forth-load-file)
1547:
1548: (defvar forth-process-buffer)
1549:
1550: (define-derived-mode inferior-forth-mode comint-mode "Inferior Forth"
1551: "Major mode for interacting with an inferior Forth process.
1552:
1553: The following commands are available:
1554: \\{inferior-forth-mode-map}
1555:
1556: A Forth process can be fired up with M-x run-forth.
1557:
1558: Customisation: Entry to this mode runs the hooks on comint-mode-hook and
1559: inferior-forth-mode-hook (in that order).
1560:
1561: You can send text to the inferior Forth process from other buffers containing
1562: Forth source.
1563: forth-switch-to-interactive switches the current buffer to the Forth
1564: process buffer.
1565: forth-send-paragraph sends the current paragraph to the Forth process.
1566: forth-send-region sends the current region to the Forth process.
1567: forth-send-buffer sends the current buffer to the Forth process.
1568:
1569: forth-send-paragraph-and-go, forth-send-region-and-go,
1570: forth-send-buffer-and-go switch to the Forth process buffer after
1571: sending their text.
1572: For information on running multiple processes in multiple buffers, see
1573: documentation for variable `forth-process-buffer'.
1574:
1575: Commands:
1576: Return after the end of the process' output sends the text from the
1577: end of process to point. If you accidentally suspend your process, use
1578: \\[comint-continue-subjob] to continue it. "
1579: ;; Customise in inferior-forth-mode-hook
1580: (setq comint-prompt-regexp "^")
1581: (setq mode-line-process '(":%s")))
1582:
1583: (defun forth-args-to-list (string)
1584: (let ((where (string-match "[ \t]" string)))
1585: (cond ((null where) (list string))
1586: ((not (= where 0))
1587: (cons (substring string 0 where)
1588: (forth-args-to-list (substring string (+ 1 where)
1589: (length string)))))
1590: (t (let ((pos (string-match "[^ \t]" string)))
1591: (if (null pos)
1592: nil
1593: (forth-args-to-list (substring string pos
1594: (length string)))))))))
1595:
1596: ;;;###autoload
1597: (defun run-forth (cmd)
1598: "Run an inferior Forth process, input and output via buffer *forth*.
1599: If there is a process already running in `*forth*', switch to that buffer.
1600: With argument, allows you to edit the command line (default is value
1601: of `forth-program-name'). Runs the hooks `inferior-forth-mode-hook'
1602: \(after the `comint-mode-hook' is run).
1603: \(Type \\[describe-mode] in the process buffer for a list of commands.)"
1604:
1605: (interactive (list (if current-prefix-arg
1606: (read-string "Run Forth: " forth-program-name)
1607: forth-program-name)))
1608: (if (not (comint-check-proc "*forth*"))
1609: (let ((cmdlist (forth-args-to-list cmd)))
1610: (set-buffer (apply 'make-comint "forth" (car cmdlist)
1611: nil (cdr cmdlist)))
1612: (inferior-forth-mode)))
1613: (setq forth-program-name cmd)
1614: (setq forth-process-buffer "*forth*")
1615: (pop-to-buffer "*forth*"))
1616:
1617: (defun forth-send-region (start end)
1618: "Send the current region to the inferior Forth process."
1619: (interactive "r")
1620: (comint-send-region (forth-proc) start end)
1621: (comint-send-string (forth-proc) "\n"))
1622:
1623: (defun forth-end-of-paragraph ()
1624: (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n "))
1625: (if (not (re-search-forward "\n[ \t]*\n" nil t))
1626: (goto-char (point-max))))
1627:
1628: (defun forth-send-paragraph ()
1629: "Send the current or the previous paragraph to the Forth process"
1630: (interactive)
1631: (let (end)
1632: (save-excursion
1633: (forth-end-of-paragraph)
1634: (skip-chars-backward "\t\n ")
1635: (setq end (point))
1.75 pazsan 1636: (if (null (re-search-backward "\n[ \t]*\n" nil t))
1.66 dvdkhlng 1637: (goto-char (point-min)))
1638: (skip-chars-forward "\t\n ")
1639: (forth-send-region (point) end))))
1640:
1641: (defun forth-send-paragraph-and-go ()
1642: "Send the current or the previous paragraph to the Forth process.
1643: Then switch to the process buffer."
1644: (interactive)
1645: (forth-send-paragraph)
1646: (forth-switch-to-interactive t))
1647:
1648: (defun forth-send-buffer ()
1649: "Send the current buffer to the Forth process."
1650: (interactive)
1651: (if (eq (current-buffer) forth-process-buffer)
1652: (error "Not allowed to send this buffer's contents to Forth"))
1653: (forth-send-region (point-min) (point-max)))
1654:
1655: (defun forth-send-buffer-and-go ()
1656: "Send the current buffer to the Forth process.
1657: Then switch to the process buffer."
1658: (interactive)
1659: (forth-send-buffer)
1660: (forth-switch-to-interactive t))
1661:
1662:
1663: (defun forth-switch-to-interactive (eob-p)
1664: "Switch to the Forth process buffer.
1665: With argument, position cursor at end of buffer."
1666: (interactive "P")
1667: (if (get-buffer forth-process-buffer)
1668: (pop-to-buffer forth-process-buffer)
1669: (error "No current process buffer. See variable `forth-process-buffer'"))
1670: (cond (eob-p
1671: (push-mark)
1672: (goto-char (point-max)))))
1673:
1.75 pazsan 1674: (defun forth-send-region-and-go (my-start end)
1.66 dvdkhlng 1675: "Send the current region to the inferior Forth process.
1676: Then switch to the process buffer."
1677: (interactive "r")
1.75 pazsan 1678: (forth-send-region my-start end)
1.66 dvdkhlng 1679: (forth-switch-to-interactive t))
1680:
1681: (defcustom forth-source-modes '(forth-mode forth-block-mode)
1682: "*Used to determine if a buffer contains Forth source code.
1683: If it's loaded into a buffer that is in one of these major modes, it's
1684: considered a Forth source file by `forth-load-file' and `forth-compile-file'.
1685: Used by these commands to determine defaults."
1686: :type '(repeat function)
1687: :group 'forth)
1688:
1689: (defvar forth-prev-l/c-dir/file nil
1690: "Caches the last (directory . file) pair.
1691: Caches the last pair used in the last `forth-load-file' or
1692: `forth-compile-file' command. Used for determining the default in the
1693: next one.")
1694:
1695: (defun forth-load-file (file-name)
1696: "Load a Forth file FILE-NAME into the inferior Forth process."
1697: (interactive (comint-get-source "Load Forth file: " forth-prev-l/c-dir/file
1698: forth-source-modes t)) ; T because LOAD
1699: ; needs an exact name
1700: (comint-check-source file-name) ; Check to see if buffer needs saved.
1.70 dvdkhlng 1701: (setq forth-prev-l/c-dir/file (cons (file-name-directory file-name)
1.66 dvdkhlng 1702: (file-name-nondirectory file-name)))
1.70 dvdkhlng 1703: (comint-send-string (forth-proc)
1704: (concat "s\" " file-name "\" included\n")))
1.66 dvdkhlng 1705:
1706:
1707: (defvar forth-process-buffer nil "*The current Forth process buffer.
1708:
1709: See `scheme-buffer' for an explanation on how to run multiple Forth
1710: processes.")
1711:
1712: (defun forth-proc ()
1713: "Return the current Forth process. See variable `forth-process-buffer'."
1714: (let ((proc (get-buffer-process (if (eq major-mode 'inferior-forth-mode)
1715: (current-buffer)
1716: forth-process-buffer))))
1717: (or proc
1718: (error "No current process. See variable `forth-process-buffer'"))))
1719: ) ; (memq 'comint features)
1.57 dvdkhlng 1720:
1721: (provide 'forth-mode)
1.29 pazsan 1722:
1.48 pazsan 1723: ;;; gforth.el ends here
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gforth.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth