[gforth] / gforth / gforth.el

gforth: gforth/gforth.el

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

CVS Admin

gforth: gforth/gforth.el

ViewCVS and CVS Help