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