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

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help