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