File:  [gforth] / gforth / gforth.el
Revision 1.16: download - view: text, annotated - select for diffs
Mon Oct 16 18:33:09 1995 UTC (25 years, 11 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>