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