Annotation of gforth/gforth.el, revision 1.46
1.17 anton 1: ;; Forth mode for Emacs
1.31 anton 2:
1.43 anton 3: ;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
1.31 anton 4:
5: ;; This file is part of Gforth.
1.1 anton 6:
1.17 anton 7: ;; GForth is distributed in the hope that it will be useful,
1.1 anton 8: ;; but WITHOUT ANY WARRANTY. No author or distributor
9: ;; accepts responsibility to anyone for the consequences of using it
10: ;; or for whether it serves any particular purpose or works at all,
11: ;; unless he says so in writing. Refer to the GNU Emacs General Public
12: ;; License for full details.
13:
14: ;; Everyone is granted permission to copy, modify and redistribute
15: ;; GNU Emacs, but only under the conditions described in the
16: ;; GNU Emacs General Public License. A copy of this license is
1.17 anton 17: ;; supposed to have been given to you along with Gforth so you
1.1 anton 18: ;; can know your rights and responsibilities. It should be in a
19: ;; file named COPYING. Among other things, the copyright notice
20: ;; and this notice must be preserved on all copies.
1.31 anton 21:
22: ;; Changes by anton
23: ;; This is a variant of forth.el that came with TILE.
24: ;; I left most of this stuff untouched and made just a few changes for
25: ;; the things I use (mainly indentation and syntax tables).
26: ;; So there is still a lot of work to do to adapt this to gforth.
1.1 anton 27:
28: ;;-------------------------------------------------------------------
29: ;; A Forth indentation, documentation search and interaction library
30: ;;-------------------------------------------------------------------
31: ;;
32: ;; Written by Goran Rydqvist, gorry@ida.liu.se, Summer 1988
33: ;; Started: 16 July 88
34: ;; Version: 2.10
35: ;; Last update: 5 December 1989 by Mikael Patel, mip@ida.liu.se
36: ;; Last update: 25 June 1990 by Goran Rydqvist, gorry@ida.liu.se
37: ;;
38: ;; Documentation: See forth-mode (^HF forth-mode)
39: ;;-------------------------------------------------------------------
40:
41:
42: (defvar forth-positives
1.36 anton 43: " : :noname m: :m code interpretation: ;code does> begin do ?do +do -do u+do u-do while if ?dup-if ?dup-0=-if else case of struct [if] [ifdef] [ifundef] [else] with public: private: class try recover "
1.34 anton 44: "*Contains all words which will cause the indent-level to be incremented
1.1 anton 45: on the next line.
46: OBS! All words in forth-positives must be surrounded by spaces.")
47:
48: (defvar forth-negatives
1.36 anton 49: " ; ;m end-code ;code does> until repeat while +loop loop -loop s+loop else then endif again endcase endof end-struct [then] [else] [endif] endwith end-class class; how: recover endtry "
1.34 anton 50: "*Contains all words which will cause the indent-level to be decremented
1.1 anton 51: on the current line.
52: OBS! All words in forth-negatives must be surrounded by spaces.")
53:
54: (defvar forth-zeroes
1.29 pazsan 55: " : :noname code interpretation: public: private: how: implements class class; "
1.34 anton 56: "*Contains all words which causes the indent to go to zero")
1.1 anton 57:
1.21 pazsan 58: (setq forth-zero 0)
59:
60: (defvar forth-zup
1.25 pazsan 61: " how: implements "
1.21 pazsan 62: "Contains all words which causes zero indent level to change")
63:
64: (defvar forth-zdown
65: " class; how: class public: private: "
66: "Contains all words which causes zero indent level to change")
67:
1.6 anton 68: (defvar forth-prefixes
69: " postpone [compile] ['] [char] "
70: "words that prefix and escape other words")
71:
1.1 anton 72: (defvar forth-mode-abbrev-table nil
73: "Abbrev table in use in Forth-mode buffers.")
74:
75: (define-abbrev-table 'forth-mode-abbrev-table ())
76:
77: (defvar forth-mode-map nil
78: "Keymap used in Forth mode.")
79:
80: (if (not forth-mode-map)
81: (setq forth-mode-map (make-sparse-keymap)))
82:
1.9 anton 83: ;(define-key forth-mode-map "\M-\C-x" 'compile)
1.7 anton 84: (define-key forth-mode-map "\C-x\\" 'comment-region)
85: (define-key forth-mode-map "\C-x~" 'forth-remove-tracers)
1.1 anton 86: (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph)
87: (define-key forth-mode-map "\eo" 'forth-send-buffer)
88: (define-key forth-mode-map "\C-x\C-m" 'forth-split)
89: (define-key forth-mode-map "\e " 'forth-reload)
90: (define-key forth-mode-map "\t" 'forth-indent-command)
91: (define-key forth-mode-map "\C-m" 'reindent-then-newline-and-indent)
1.7 anton 92: (define-key forth-mode-map "\M-q" 'forth-fill-paragraph)
1.13 pazsan 93: (define-key forth-mode-map "\e." 'forth-find-tag)
1.1 anton 94:
1.35 anton 95: ;setup for C-h C-i to work
96: (if (fboundp 'info-lookup-add-help)
97: (info-lookup-add-help
98: :topic 'symbol
99: :mode 'forth-mode
100: :regexp "[^
101: ]+"
102: :ignore-case t
103: :doc-spec '(("(gforth)Name Index" nil "`" "' "))))
104:
1.22 anton 105: (load "etags")
1.13 pazsan 106:
107: (defun forth-find-tag (tagname &optional next-p regexp-p)
108: (interactive (find-tag-interactive "Find tag: "))
109: (switch-to-buffer
110: (find-tag-noselect (concat " " tagname " ") next-p regexp-p)))
111:
1.1 anton 112: (defvar forth-mode-syntax-table nil
113: "Syntax table in use in Forth-mode buffers.")
114:
115: (if (not forth-mode-syntax-table)
116: (progn
117: (setq forth-mode-syntax-table (make-syntax-table))
1.6 anton 118: (let ((char 0))
119: (while (< char ?!)
120: (modify-syntax-entry char " " forth-mode-syntax-table)
121: (setq char (1+ char)))
122: (while (< char 256)
123: (modify-syntax-entry char "w" forth-mode-syntax-table)
124: (setq char (1+ char))))
125: (modify-syntax-entry ?\" "\"" forth-mode-syntax-table)
126: (modify-syntax-entry ?\\ "<" forth-mode-syntax-table)
127: (modify-syntax-entry ?\n ">" forth-mode-syntax-table)
128: ))
129: ;I do not define '(' and ')' as comment delimiters, because emacs
130: ;only supports one comment syntax (and a hack to accomodate C++); I
131: ;use '\' for natural language comments and '(' for formal comments
132: ;like stack comments, so for me it's better to have emacs treat '\'
1.13 pazsan 133: ;comments as comments. If you want it different, make the appropriate
1.6 anton 134: ;changes (best in your .emacs file).
135: ;
136: ;Hmm, the C++ hack could be used to support both comment syntaxes: we
137: ;can have different comment styles, if both comments start with the
138: ;same character. we could use ' ' as first and '(' and '\' as second
139: ;character. However this would fail for G\ comments.
1.1 anton 140:
141: (defconst forth-indent-level 4
142: "Indentation of Forth statements.")
143:
144: (defun forth-mode-variables ()
145: (set-syntax-table forth-mode-syntax-table)
146: (setq local-abbrev-table forth-mode-abbrev-table)
147: (make-local-variable 'paragraph-start)
148: (setq paragraph-start (concat "^$\\|" page-delimiter))
149: (make-local-variable 'paragraph-separate)
150: (setq paragraph-separate paragraph-start)
151: (make-local-variable 'indent-line-function)
152: (setq indent-line-function 'forth-indent-line)
1.6 anton 153: ; (make-local-variable 'require-final-newline)
154: ; (setq require-final-newline t)
1.1 anton 155: (make-local-variable 'comment-start)
1.3 anton 156: (setq comment-start "\\ ")
157: ;(make-local-variable 'comment-end)
158: ;(setq comment-end " )")
1.1 anton 159: (make-local-variable 'comment-column)
160: (setq comment-column 40)
161: (make-local-variable 'comment-start-skip)
1.3 anton 162: (setq comment-start-skip "\\ ")
1.46 ! anton 163: ; this is obsolete (according to 20.5 docs) and replace with comment-indent-function
! 164: ; (make-local-hook 'comment-indent-hook)
! 165: ; (add-hook 'comment-indent-hook 'forth-comment-indent nil t)
! 166: (make-local-variable 'comment-indent-function)
! 167: (setq comment-indent-function 'forth-comment-indent)
1.1 anton 168: (make-local-variable 'parse-sexp-ignore-comments)
169: (setq parse-sexp-ignore-comments t))
170:
1.2 anton 171: ;;;###autoload
1.1 anton 172: (defun forth-mode ()
173: "
174: Major mode for editing Forth code. Tab indents for Forth code. Comments
1.9 anton 175: are delimited with \\ and newline. Paragraphs are separated by blank lines
1.23 anton 176: only.
1.1 anton 177: \\{forth-mode-map}
178: Forth-split
179: Positions the current buffer on top and a forth-interaction window
180: below. The window size is controlled by the forth-percent-height
181: variable (see below).
182: Forth-reload
183: Reloads the forth library and restarts the forth process.
184: Forth-send-buffer
185: Sends the current buffer, in text representation, as input to the
186: forth process.
187: Forth-send-paragraph
188: Sends the previous or the current paragraph to the forth-process.
189: Note that the cursor only need to be with in the paragraph to be sent.
190: forth-documentation
191: Search for documentation of forward adjacent to cursor. Note! To use
192: this mode you have to add a line, to your .emacs file, defining the
193: directories to search through for documentation files (se variable
194: forth-help-load-path below) e.g. (setq forth-help-load-path '(nil)).
195:
196: Variables controlling interaction and startup
197: forth-percent-height
198: Tells split how high to make the edit portion, in percent of the
199: current screen height.
200: forth-program-name
201: Tells the library which program name to execute in the interation
202: window.
203:
204: Variables controlling indentation style:
205: forth-positives
206: A string containing all words which causes the indent-level of the
207: following line to be incremented.
208: OBS! Each word must be surronded by spaces.
209: forth-negatives
210: A string containing all words which causes the indentation of the
211: current line to be decremented, if the word begin the line. These
212: words also has a cancelling effect on the indent-level of the
213: following line, independent of position.
214: OBS! Each word must be surronded by spaces.
215: forth-zeroes
216: A string containing all words which causes the indentation of the
217: current line to go to zero, if the word begin the line.
218: OBS! Each word must be surronded by spaces.
219: forth-indent-level
220: Indentation increment/decrement of Forth statements.
221:
222: Note! A word which decrements the indentation of the current line, may
223: also be mentioned in forth-positives to cause the indentation to
224: resume the previous level.
225:
226: Variables controling documentation search
227: forth-help-load-path
228: List of directories to search through to find *.doc
229: (forth-help-file-suffix) files. Nil means current default directory.
230: The specified directories must contain at least one .doc file. If it
231: does not and you still want the load-path to scan that directory, create
232: an empty file dummy.doc.
233: forth-help-file-suffix
234: The file names to search for in each directory specified by
235: forth-help-load-path. Defaulted to '*.doc'.
236: "
237: (interactive)
238: (kill-all-local-variables)
239: (use-local-map forth-mode-map)
240: (setq mode-name "Forth")
241: (setq major-mode 'forth-mode)
242: (forth-mode-variables)
243: ; (if (not (forth-process-running-p))
244: ; (run-forth forth-program-name))
245: (run-hooks 'forth-mode-hook))
246:
1.44 anton 247: (add-hook 'forth-mode-hook
1.9 anton 248: '(lambda ()
249: (make-local-variable 'compile-command)
250: (setq compile-command "gforth ")))
1.6 anton 251:
1.7 anton 252: (defun forth-fill-paragraph ()
253: "Fill comments (starting with '\'; do not fill code (block style
254: programmers who tend to fill code won't use emacs anyway:-)."
1.9 anton 255: ; Currently only comments at the start of the line are filled.
256: ; Something like lisp-fill-paragraph may be better. We cannot use
257: ; fill-paragraph, because it removes the \ from the first comment
258: ; line. Therefore we have to look for the first line of the comment
259: ; and use fill-region.
1.7 anton 260: (interactive)
261: (save-excursion
262: (beginning-of-line)
1.9 anton 263: (while (and
264: (= (forward-line -1) 0)
1.14 anton 265: (looking-at "[ \t]*\\\\g?[ \t]+")))
266: (if (not (looking-at "[ \t]*\\\\g?[ \t]+"))
1.9 anton 267: (forward-line 1))
268: (let ((from (point))
269: (to (save-excursion (forward-paragraph) (point))))
1.14 anton 270: (if (looking-at "[ \t]*\\\\g?[ \t]+")
1.9 anton 271: (progn (goto-char (match-end 0))
272: (set-fill-prefix)
273: (fill-region from to nil))))))
1.7 anton 274:
1.1 anton 275: (defun forth-comment-indent ()
276: (save-excursion
277: (beginning-of-line)
278: (if (looking-at ":[ \t]*")
279: (progn
280: (end-of-line)
281: (skip-chars-backward " \t\n")
282: (1+ (current-column)))
283: comment-column)))
284:
285: (defun forth-current-indentation ()
286: (save-excursion
287: (beginning-of-line)
288: (back-to-indentation)
289: (current-column)))
290:
291: (defun forth-delete-indentation ()
292: (let ((b nil) (m nil))
293: (save-excursion
294: (beginning-of-line)
295: (setq b (point))
296: (back-to-indentation)
297: (setq m (point)))
298: (delete-region b m)))
299:
300: (defun forth-indent-line (&optional flag)
301: "Correct indentation of the current Forth line."
302: (let ((x (forth-calculate-indent)))
303: (forth-indent-to x)))
304:
305: (defun forth-indent-command ()
306: (interactive)
307: (forth-indent-line t))
308:
309: (defun forth-indent-to (x)
310: (let ((p nil))
311: (setq p (- (current-column) (forth-current-indentation)))
312: (forth-delete-indentation)
313: (beginning-of-line)
314: (indent-to x)
315: (if (> p 0) (forward-char p))))
316:
317: ;;Calculate indent
318: (defun forth-calculate-indent ()
319: (let ((w1 nil) (indent 0) (centre 0))
320: (save-excursion
321: (beginning-of-line)
322: (skip-chars-backward " \t\n")
323: (beginning-of-line)
324: (back-to-indentation)
325: (setq indent (current-column))
326: (setq centre indent)
327: (setq indent (+ indent (forth-sum-line-indentation))))
328: (save-excursion
329: (beginning-of-line)
330: (back-to-indentation)
331: (let ((p (point)))
332: (skip-chars-forward "^ \t\n")
333: (setq w1 (buffer-substring p (point)))))
334: (if (> (- indent centre) forth-indent-level)
335: (setq indent (+ centre forth-indent-level)))
336: (if (> (- centre indent) forth-indent-level)
337: (setq indent (- centre forth-indent-level)))
338: (if (< indent 0) (setq indent 0))
339: (setq indent (- indent
340: (if (string-match
341: (regexp-quote (concat " " w1 " "))
342: forth-negatives)
343: forth-indent-level 0)))
1.21 pazsan 344: (if (string-match (regexp-quote (concat " " w1 " ")) forth-zdown)
345: (setq forth-zero 0))
1.1 anton 346: (if (string-match (regexp-quote (concat " " w1 " ")) forth-zeroes)
1.21 pazsan 347: (setq indent forth-zero))
348: (if (string-match (regexp-quote (concat " " w1 " ")) forth-zup)
349: (setq forth-zero 4))
1.1 anton 350: indent))
351:
352: (defun forth-sum-line-indentation ()
353: "Add upp the positive and negative weights of all words on the current line."
354: (let ((b (point)) (e nil) (sum 0) (w nil) (t1 nil) (t2 nil) (first t))
355: (end-of-line) (setq e (point))
356: (goto-char b)
357: (while (< (point) e)
358: (setq w (forth-next-word))
359: (setq t1 (string-match (regexp-quote (concat " " w " "))
360: forth-positives))
361: (setq t2 (string-match (regexp-quote (concat " " w " "))
362: forth-negatives))
363: (if t1
364: (setq sum (+ sum forth-indent-level)))
365: (if (and t2 (not first))
366: (setq sum (- sum forth-indent-level)))
367: (skip-chars-forward " \t")
368: (setq first nil))
369: sum))
370:
371:
372: (defun forth-next-word ()
1.6 anton 373: "Return the next forth-word. Skip anything that the forth-word takes from
374: the input stream (comments, arguments, etc.)"
375: ;actually, it would be better to use commands based on the
376: ;syntax-table or comment-start etc.
1.1 anton 377: (let ((w1 nil))
378: (while (not w1)
379: (skip-chars-forward " \t\n")
380: (let ((p (point)))
381: (skip-chars-forward "^ \t\n")
382: (setq w1 (buffer-substring p (point))))
383: (cond ((string-match "\"" w1)
384: (progn
1.6 anton 385: (skip-chars-forward "^\"\n")
386: (forward-char)))
387: ((string-match "\\\\" w1)
388: (progn
389: (end-of-line)
390: ))
391: ((or (equal "(" w1) (equal ".(" w1))
1.1 anton 392: (progn
1.6 anton 393: (skip-chars-forward "^)\n")
394: (forward-char)))
395: ((string-match (regexp-quote (concat " " w1 " ")) forth-prefixes)
396: (progn (skip-chars-forward " \t\n")
397: (skip-chars-forward "^ \t\n")))
1.1 anton 398: (t nil)))
399: w1))
400:
401:
402: ;; Forth commands
403:
1.7 anton 404: (defun forth-remove-tracers ()
405: "Remove tracers of the form `~~ '. Queries the user for each occurrence."
406: (interactive)
1.16 anton 407: (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil))
1.7 anton 408:
1.5 anton 409: (defvar forth-program-name "gforth"
1.1 anton 410: "*Program invoked by the `run-forth' command.")
411:
412: (defvar forth-band-name nil
413: "*Band loaded by the `run-forth' command.")
414:
415: (defvar forth-program-arguments nil
416: "*Arguments passed to the Forth program by the `run-forth' command.")
417:
418: (defun run-forth (command-line)
419: "Run an inferior Forth process. Output goes to the buffer `*forth*'.
420: With argument, asks for a command line. Split up screen and run forth
421: in the lower portion. The current-buffer when called will stay in the
422: upper portion of the screen, and all other windows are deleted.
423: Call run-forth again to make the *forth* buffer appear in the lower
424: part of the screen."
425: (interactive
426: (list (let ((default
427: (or forth-process-command-line
428: (forth-default-command-line))))
429: (if current-prefix-arg
430: (read-string "Run Forth: " default)
431: default))))
432: (setq forth-process-command-line command-line)
433: (forth-start-process command-line)
434: (forth-split)
435: (forth-set-runlight forth-runlight:input))
436:
1.28 anton 437: (defun run-forth-if-not ()
438: (if (not (forth-process-running-p))
439: (run-forth forth-program-name)))
440:
1.1 anton 441: (defun reset-forth ()
442: "Reset the Forth process."
443: (interactive)
444: (let ((process (get-process forth-program-name)))
445: (cond ((or (not process)
446: (not (eq (process-status process) 'run))
447: (yes-or-no-p
448: "The Forth process is running, are you SURE you want to reset it? "))
449: (message "Resetting Forth process...")
450: (forth-reload)
451: (message "Resetting Forth process...done")))))
452:
453: (defun forth-default-command-line ()
1.13 pazsan 454: (concat forth-program-name
1.1 anton 455: (if forth-program-arguments
456: (concat " " forth-program-arguments)
457: "")))
458:
459: ;;;; Internal Variables
460:
461: (defvar forth-process-command-line nil
462: "Command used to start the most recent Forth process.")
463:
464: (defvar forth-previous-send ""
465: "Most recent expression transmitted to the Forth process.")
466:
467: (defvar forth-process-filter-queue '()
468: "Queue used to synchronize filter actions properly.")
469:
470: (defvar forth-prompt "ok"
471: "The current forth prompt string.")
472:
473: (defvar forth-start-hook nil
474: "If non-nil, a procedure to call when the Forth process is started.
475: When called, the current buffer will be the Forth process-buffer.")
476:
477: (defvar forth-signal-death-message nil
478: "If non-nil, causes a message to be generated when the Forth process dies.")
479:
1.9 anton 480: (defvar forth-percent-height 50
1.1 anton 481: "Tells run-forth how high the upper window should be in percent.")
482:
483: (defconst forth-runlight:input ?I
484: "The character displayed when the Forth process is waiting for input.")
485:
486: (defvar forth-mode-string ""
487: "String displayed in the mode line when the Forth process is running.")
488:
489: ;;;; Evaluation Commands
490:
491: (defun forth-send-string (&rest strings)
492: "Send the string arguments to the Forth process.
493: The strings are concatenated and terminated by a newline."
494: (cond ((forth-process-running-p)
495: (forth-send-string-1 strings))
496: ((yes-or-no-p "The Forth process has died. Reset it? ")
497: (reset-forth)
498: (goto-char (point-max))
499: (forth-send-string-1 strings))))
500:
501: (defun forth-send-string-1 (strings)
502: (let ((string (apply 'concat strings)))
503: (forth-send-string-2 string)))
504:
505: (defun forth-send-string-2 (string)
506: (let ((process (get-process forth-program-name)))
507: (if (not (eq (current-buffer) (get-buffer forth-program-name)))
508: (progn
509: (forth-process-filter-output string)
510: (forth-process-filter:finish)))
511: (send-string process (concat string "\n"))
512: (if (eq (current-buffer) (process-buffer process))
513: (set-marker (process-mark process) (point)))))
514:
515:
516: (defun forth-send-region (start end)
517: "Send the current region to the Forth process.
518: The region is sent terminated by a newline."
519: (interactive "r")
520: (let ((process (get-process forth-program-name)))
521: (if (and process (eq (current-buffer) (process-buffer process)))
522: (progn (goto-char end)
523: (set-marker (process-mark process) end))))
524: (forth-send-string "\n" (buffer-substring start end) "\n"))
525:
526: (defun forth-end-of-paragraph ()
527: (if (looking-at "[\t\n ]+") (skip-chars-backward "\t\n "))
528: (if (not (re-search-forward "\n[ \t]*\n" nil t))
529: (goto-char (point-max))))
530:
531: (defun forth-send-paragraph ()
532: "Send the current or the previous paragraph to the Forth process"
533: (interactive)
534: (let (end)
535: (save-excursion
536: (forth-end-of-paragraph)
537: (skip-chars-backward "\t\n ")
538: (setq end (point))
539: (if (re-search-backward "\n[ \t]*\n" nil t)
540: (setq start (point))
541: (goto-char (point-min)))
542: (skip-chars-forward "\t\n ")
543: (forth-send-region (point) end))))
544:
545: (defun forth-send-buffer ()
546: "Send the current buffer to the Forth process."
547: (interactive)
548: (if (eq (current-buffer) (forth-process-buffer))
549: (error "Not allowed to send this buffer's contents to Forth"))
550: (forth-send-region (point-min) (point-max)))
551:
552:
553: ;;;; Basic Process Control
554:
555: (defun forth-start-process (command-line)
556: (let ((buffer (get-buffer-create "*forth*")))
557: (let ((process (get-buffer-process buffer)))
558: (save-excursion
559: (set-buffer buffer)
560: (progn (if process (delete-process process))
561: (goto-char (point-max))
562: (setq mode-line-process '(": %s"))
563: (add-to-global-mode-string 'forth-mode-string)
564: (setq process
565: (apply 'start-process
566: (cons forth-program-name
567: (cons buffer
568: (forth-parse-command-line
569: command-line)))))
570: (set-marker (process-mark process) (point-max))
571: (forth-process-filter-initialize t)
572: (forth-modeline-initialize)
573: (set-process-sentinel process 'forth-process-sentinel)
574: (set-process-filter process 'forth-process-filter)
575: (run-hooks 'forth-start-hook)))
576: buffer)))
577:
578: (defun forth-parse-command-line (string)
579: (setq string (substitute-in-file-name string))
580: (let ((start 0)
581: (result '()))
582: (while start
583: (let ((index (string-match "[ \t]" string start)))
584: (setq start
585: (cond ((not index)
586: (setq result
587: (cons (substring string start)
588: result))
589: nil)
590: ((= index start)
591: (string-match "[^ \t]" string start))
592: (t
593: (setq result
594: (cons (substring string start index)
595: result))
596: (1+ index))))))
597: (nreverse result)))
598:
599:
600: (defun forth-process-running-p ()
601: "True iff there is a Forth process whose status is `run'."
602: (let ((process (get-process forth-program-name)))
603: (and process
604: (eq (process-status process) 'run))))
605:
606: (defun forth-process-buffer ()
607: (let ((process (get-process forth-program-name)))
608: (and process (process-buffer process))))
609:
610: ;;;; Process Filter
611:
612: (defun forth-process-sentinel (proc reason)
613: (let ((inhibit-quit nil))
614: (forth-process-filter-initialize (eq reason 'run))
615: (if (eq reason 'run)
616: (forth-modeline-initialize)
617: (setq forth-mode-string "")))
618: (if (and (not (memq reason '(run stop)))
619: forth-signal-death-message)
620: (progn (beep)
621: (message
622: "The Forth process has died! Do M-x reset-forth to restart it"))))
623:
624: (defun forth-process-filter-initialize (running-p)
625: (setq forth-process-filter-queue (cons '() '()))
626: (setq forth-prompt "ok"))
627:
628:
629: (defun forth-process-filter (proc string)
630: (forth-process-filter-output string)
631: (forth-process-filter:finish))
632:
633: (defun forth-process-filter:enqueue (action)
634: (let ((next (cons action '())))
635: (if (cdr forth-process-filter-queue)
636: (setcdr (cdr forth-process-filter-queue) next)
637: (setcar forth-process-filter-queue next))
638: (setcdr forth-process-filter-queue next)))
639:
640: (defun forth-process-filter:finish ()
641: (while (car forth-process-filter-queue)
642: (let ((next (car forth-process-filter-queue)))
643: (setcar forth-process-filter-queue (cdr next))
644: (if (not (cdr next))
645: (setcdr forth-process-filter-queue '()))
646: (apply (car (car next)) (cdr (car next))))))
647:
648: ;;;; Process Filter Output
649:
650: (defun forth-process-filter-output (&rest args)
651: (if (not (and args
652: (null (cdr args))
653: (stringp (car args))
654: (string-equal "" (car args))))
655: (forth-process-filter:enqueue
656: (cons 'forth-process-filter-output-1 args))))
657:
658: (defun forth-process-filter-output-1 (&rest args)
659: (save-excursion
660: (forth-goto-output-point)
661: (apply 'insert-before-markers args)))
662:
663: (defun forth-guarantee-newlines (n)
664: (save-excursion
665: (forth-goto-output-point)
666: (let ((stop nil))
667: (while (and (not stop)
668: (bolp))
669: (setq n (1- n))
670: (if (bobp)
671: (setq stop t)
672: (backward-char))))
673: (forth-goto-output-point)
674: (while (> n 0)
675: (insert-before-markers ?\n)
676: (setq n (1- n)))))
677:
678: (defun forth-goto-output-point ()
679: (let ((process (get-process forth-program-name)))
680: (set-buffer (process-buffer process))
681: (goto-char (process-mark process))))
682:
683: (defun forth-modeline-initialize ()
684: (setq forth-mode-string " "))
685:
686: (defun forth-set-runlight (runlight)
687: (aset forth-mode-string 0 runlight)
688: (forth-modeline-redisplay))
689:
690: (defun forth-modeline-redisplay ()
691: (save-excursion (set-buffer (other-buffer)))
692: (set-buffer-modified-p (buffer-modified-p))
693: (sit-for 0))
694:
695: ;;;; Process Filter Operations
696:
697: (defun add-to-global-mode-string (x)
698: (cond ((null global-mode-string)
699: (setq global-mode-string (list "" x " ")))
700: ((not (memq x global-mode-string))
701: (setq global-mode-string
702: (cons ""
703: (cons x
704: (cons " "
705: (if (equal "" (car global-mode-string))
706: (cdr global-mode-string)
707: global-mode-string))))))))
708:
709:
710: ;; Misc
711:
712: (setq auto-mode-alist (append auto-mode-alist
1.4 pazsan 713: '(("\\.fs$" . forth-mode))))
1.1 anton 714:
715: (defun forth-split ()
716: (interactive)
717: (forth-split-1 "*forth*"))
718:
719: (defun forth-split-1 (buffer)
720: (if (not (eq (window-buffer) (get-buffer buffer)))
721: (progn
722: (delete-other-windows)
723: (split-window-vertically
724: (/ (* (screen-height) forth-percent-height) 100))
725: (other-window 1)
726: (switch-to-buffer buffer)
727: (goto-char (point-max))
728: (other-window 1))))
729:
730: (defun forth-reload ()
731: (interactive)
732: (let ((process (get-process forth-program-name)))
733: (if process (kill-process process t)))
1.28 anton 734: (sleep-for 0 100)
1.1 anton 735: (forth-mode))
736:
737:
738: ;; Special section for forth-help
739:
740: (defvar forth-help-buffer "*Forth-help*"
741: "Buffer used to display the requested documentation.")
742:
743: (defvar forth-help-load-path nil
744: "List of directories to search through to find *.doc
745: (forth-help-file-suffix) files. Nil means current default directory.
746: The specified directories must contain at least one .doc file. If it
747: does not and you still want the load-path to scan that directory, create
748: an empty file dummy.doc.")
749:
750: (defvar forth-help-file-suffix "*.doc"
751: "The file names to search for in each directory.")
752:
753: (setq forth-search-command-prefix "grep -n \"^ [^(]* ")
754: (defvar forth-search-command-suffix "/dev/null")
755: (defvar forth-grep-error-regexp ": No such file or directory")
756:
757: (defun forth-function-called-at-point ()
758: "Return the space delimited word a point."
759: (save-excursion
760: (save-restriction
761: (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
762: (skip-chars-backward "^ \t\n" (point-min))
763: (if (looking-at "[ \t\n]")
764: (forward-char 1))
765: (let (obj (p (point)))
766: (skip-chars-forward "^ \t\n")
767: (buffer-substring p (point))))))
768:
769: (defun forth-help-names-extend-comp (path-list result)
770: (cond ((null path-list) result)
771: ((null (car path-list))
772: (forth-help-names-extend-comp (cdr path-list)
773: (concat result forth-help-file-suffix " ")))
774: (t (forth-help-names-extend-comp
775: (cdr path-list) (concat result
776: (expand-file-name (car path-list)) "/"
777: forth-help-file-suffix " ")))))
778:
779: (defun forth-help-names-extended ()
780: (if forth-help-load-path
781: (forth-help-names-extend-comp forth-help-load-path "")
782: (error "forth-help-load-path not specified")))
783:
784:
1.7 anton 785: ;(define-key forth-mode-map "\C-hf" 'forth-documentation)
1.1 anton 786:
787: (defun forth-documentation (function)
788: "Display the full documentation of FORTH word."
789: (interactive
790: (let ((fn (forth-function-called-at-point))
791: (enable-recursive-minibuffers t)
792: search-list
793: val)
794: (setq val (read-string (format "Describe forth word (default %s): " fn)))
795: (list (if (equal val "") fn val))))
796: (forth-get-doc (concat forth-search-command-prefix
797: (grep-regexp-quote (concat function " ("))
798: "[^)]*\-\-\" " (forth-help-names-extended)
799: forth-search-command-suffix))
800: (message "C-x C-m switches back to the forth interaction window"))
801:
802: (defun forth-get-doc (command)
803: "Display the full documentation of command."
804: (let ((curwin (get-buffer-window (window-buffer)))
805: reswin
806: pointmax)
807: (with-output-to-temp-buffer forth-help-buffer
808: (progn
809: (call-process "sh" nil forth-help-buffer t "-c" command)
810: (setq reswin (get-buffer-window forth-help-buffer))))
811: (setq reswin (get-buffer-window forth-help-buffer))
812: (select-window reswin)
813: (save-excursion
814: (goto-char (setq pointmax (point-max)))
815: (insert "--------------------\n\n"))
816: (let (fd doc)
817: (while (setq fd (forth-get-file-data pointmax))
818: (setq doc (forth-get-doc-string fd))
819: (save-excursion
820: (goto-char (point-max))
821: (insert (substring (car fd) (string-match "[^/]*$" (car fd)))
822: ":\n\n" doc "\n")))
823: (if (not doc)
824: (progn (goto-char (point-max)) (insert "Not found"))))
825: (select-window curwin)))
826:
827: (defun forth-skip-error-lines ()
828: (let ((lines 0))
829: (save-excursion
830: (while (re-search-forward forth-grep-error-regexp nil t)
831: (beginning-of-line)
832: (forward-line 1)
833: (setq lines (1+ lines))))
834: (forward-line lines)))
835:
836: (defun forth-get-doc-string (fd)
837: "Find file (car fd) and extract documentation from line (nth 1 fd)."
838: (let (result)
839: (save-window-excursion
840: (find-file (car fd))
841: (goto-line (nth 1 fd))
842: (if (not (eq (nth 1 fd) (1+ (count-lines (point-min) (point)))))
843: (error "forth-get-doc-string: serious error"))
844: (if (not (re-search-backward "\n[\t ]*\n" nil t))
845: (goto-char (point-min))
846: (goto-char (match-end 0)))
847: (let ((p (point)))
848: (if (not (re-search-forward "\n[\t ]*\n" nil t))
849: (goto-char (point-max)))
850: (setq result (buffer-substring p (point))))
851: (bury-buffer (current-buffer)))
852: result))
853:
854: (defun forth-get-file-data (limit)
855: "Parse grep output and return '(filename line#) list. Return nil when
856: passing limit."
857: (forth-skip-error-lines)
858: (if (< (point) limit)
859: (let ((result (forth-get-file-data-cont limit)))
860: (forward-line 1)
861: (beginning-of-line)
862: result)))
863:
864: (defun forth-get-file-data-cont (limit)
865: (let (result)
866: (let ((p (point)))
867: (skip-chars-forward "^:")
868: (setq result (buffer-substring p (point))))
869: (if (< (point) limit)
870: (let ((p (1+ (point))))
871: (forward-char 1)
872: (skip-chars-forward "^:")
873: (list result (string-to-int (buffer-substring p (point))))))))
874:
875: (defun grep-regexp-quote (str)
876: (let ((i 0) (m 1) (res ""))
877: (while (/= m 0)
878: (setq m (string-to-char (substring str i)))
879: (if (/= m 0)
880: (progn
881: (setq i (1+ i))
882: (if (string-match (regexp-quote (char-to-string m))
883: ".*\\^$[]")
884: (setq res (concat res "\\")))
885: (setq res (concat res (char-to-string m))))))
886: res))
887:
888:
1.9 anton 889: (define-key forth-mode-map "\C-x\C-e" 'compile)
1.1 anton 890: (define-key forth-mode-map "\C-x\C-n" 'next-error)
891: (require 'compile "compile")
892:
1.6 anton 893: (defvar forth-compile-command "gforth ")
1.9 anton 894: ;(defvar forth-compilation-window-percent-height 30)
1.1 anton 895:
896: (defun forth-compile (command)
897: (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command))))
898: (forth-split-1 "*compilation*")
899: (setq ctools-compile-command command)
900: (compile1 ctools-compile-command "No more errors"))
901:
902:
1.12 pazsan 903: ;;; Forth menu
904: ;;; Mikael Karlsson <qramika@eras70.ericsson.se>
905:
906: (cond ((string-match "XEmacs\\|Lucid" emacs-version)
907: (require 'func-menu)
908:
909: (defconst fume-function-name-regexp-forth
910: "^\\(:\\)[ \t]+\\([^ \t]*\\)"
911: "Expression to get word definitions in Forth.")
912:
913: (setq fume-function-name-regexp-alist
914: (append '((forth-mode . fume-function-name-regexp-forth)
915: ) fume-function-name-regexp-alist))
916:
917: ;; Find next forth word in the buffer
918: (defun fume-find-next-forth-function-name (buffer)
919: "Searches for the next forth word in BUFFER."
920: (set-buffer buffer)
921: (if (re-search-forward fume-function-name-regexp nil t)
922: (let ((beg (match-beginning 2))
923: (end (match-end 2)))
924: (cons (buffer-substring beg end) beg))))
925:
926: (setq fume-find-function-name-method-alist
927: (append '((forth-mode . fume-find-next-forth-function-name))))
928:
929: ))
930: ;;; End Forth menu
931:
932: ;;; File folding of forth-files
933: ;;; uses outline
934: ;;; Toggle activation with M-x fold-f (when editing a forth-file)
935: ;;; Use f9 to expand, f10 to hide, Or the menubar in xemacs
936: ;;;
937: ;;; Works most of the times but loses sync with the cursor occasionally
938: ;;; Could be improved by also folding on comments
939:
940: (require 'outline)
941:
1.29 pazsan 942: (defun f-outline-level ()
943: (cond ((looking-at "\\`\\\\")
944: 0)
945: ((looking-at "\\\\ SEC")
946: 0)
947: ((looking-at "\\\\ \\\\ .*")
948: 0)
949: ((looking-at "\\\\ DEFS")
950: 1)
951: ((looking-at "\\/\\* ")
952: 1)
953: ((looking-at ": .*")
954: 1)
955: ((looking-at "\\\\G")
956: 2)
957: ((looking-at "[ \t]+\\\\")
958: 3))
959: )
1.12 pazsan 960:
961: (defun fold-f ()
962: (interactive)
963: (add-hook 'outline-minor-mode-hook 'hide-body)
964:
965: ; outline mode header start, i.e. find word definitions
1.29 pazsan 966: ;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)")
967: (setq outline-regexp "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*")
968: (setq outline-level 'f-outline-level)
1.12 pazsan 969:
970: (outline-minor-mode)
1.30 anton 971: (define-key outline-minor-mode-map '(shift up) 'hide-sublevels)
972: (define-key outline-minor-mode-map '(shift right) 'show-children)
973: (define-key outline-minor-mode-map '(shift left) 'hide-subtree)
974: (define-key outline-minor-mode-map '(shift down) 'show-subtree)
1.29 pazsan 975:
1.12 pazsan 976: )
1.29 pazsan 977:
978: ;;(define-key global-map '(shift up) 'fold-f)
979:
1.12 pazsan 980: ;;; end file folding
981:
982: ;;; func-menu is a package that scans your source file for function definitions
983: ;;; and makes a menubar entry that lets you jump to any particular function
984: ;;; definition by selecting it from the menu. The following code turns this on
985: ;;; for all of the recognized languages. Scanning the buffer takes some time,
986: ;;; but not much.
987: ;;;
988: (cond ((string-match "XEmacs\\|Lucid" emacs-version)
989: (require 'func-menu)
990: ;; (define-key global-map 'f8 'function-menu)
991: (add-hook 'find-fible-hooks 'fume-add-menubar-entry)
1.30 anton 992: ; (define-key global-map "\C-cg" 'fume-prompt-function-goto)
993: ; (define-key global-map '(shift button3) 'mouse-function-menu)
1.29 pazsan 994: ))
995:
1.37 pazsan 996: ;;; Highlighting
997:
1.46 ! anton 998: ; (cond ((featurep 'hilit19)
! 999: ; (if (not (file-exists-p "/usr/share/emacs/site-lisp/hl319.el"))
! 1000: ; (require 'hilit19)
! 1001: ; (require 'hl319))
! 1002:
! 1003: ; (hilit-set-mode-patterns
! 1004: ; '(forth-mode)
! 1005: ; (append
! 1006: ; '(("\\\\ \\(.*\\)$" nil comment)) ; comments
! 1007: ; '(("\\\\[gG] \\(.*\\)$" nil comment)) ; comments
! 1008: ; '(("(\\( [^)\n]* \\| \\)--\\( [^)\n]* \\| \\))" nil decl))
! 1009: ; '(("( " ")" comment))
! 1010: ; '(("\" [^\"\n]*\"" nil string))
! 1011: ; '(("\\(\\[IF]\\|\\[IFDEF]\\|\\[IFUNDEF]\\|\\[ELSE]\\|\\[THEN]\\|IF\\|ELSE\\|THEN\\|CASE\\|ENDCASE\\|OF\\|ENDOF\\|BEGIN\\|WHILE\\|REPEAT\\|UNTIL\\|AGAIN\\|DOES>\\|?DO\\|DO\\|\+LOOP\\|UNLOOP\\|LOOP\\|EXIT\\)" nil keyword))
! 1012: ; '(("\\(\\[if]\\|\\[ifdef]\\|\\[ifundef]\\|\\[else]\\|\\[then]\\|if\\|else\\|then\\|case\\|endcase\\|of\\|endof\\|begin\\|while\\|repeat\\|until\\|again\\|does>\\|?do\\|do\\|\+loop\\|unloop\\|loop\\|exit\\)" nil keyword))
! 1013: ; '((": *[^ \n]*" nil defun))
! 1014: ; '(("Defer *[^ \n]*" nil defun))
! 1015: ; '(("\\(Variable\\|Constant\\|Value\\|Create\\) *[^ \n]*" nil define))
! 1016: ; '(("\\(include\\|require\\) *[^ \n]*" nil include))
! 1017: ; '(("[\n ]\\(\\$[0-9A-Fa-f]+[\n ]\\|&[0-9]+[\n ]\\|[0-9]+[\n ]\\|%[01]+[\n ]\\|'[^ \n]+\\)+" nil formula))
! 1018: ; '((":noname" nil defun))))))
1.37 pazsan 1019:
1.29 pazsan 1020: ;; end
1021:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>