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