--- gforth/gforth.el	1994/07/08 15:00:41	1.3
+++ gforth/gforth.el	1998/05/13 16:47:23	1.30
@@ -1,7 +1,12 @@
-;; This file is part of GNU Emacs.
+;; Forth mode for Emacs
+;; This file is part of GForth.
 ;; Changes by anton
+;; This is a variant of forth.el that came with TILE.
+;; I left most of this stuff untouched and made just a few changes for 
+;; the things I use (mainly indentation and syntax tables).
+;; So there is still a lot of work to do to adapt this to gforth.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; GForth is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY.  No author or distributor
 ;; accepts responsibility to anyone for the consequences of using it
 ;; or for whether it serves any particular purpose or works at all,
@@ -11,13 +16,11 @@
 ;; Everyone is granted permission to copy, modify and redistribute
 ;; GNU Emacs, but only under the conditions described in the
 ;; GNU Emacs General Public License.   A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
+;; supposed to have been given to you along with Gforth so you
 ;; can know your rights and responsibilities.  It should be in a
 ;; file named COPYING.  Among other things, the copyright notice
 ;; and this notice must be preserved on all copies.
 
-;;; $Header: /nfs/unsafe/cvs-repository/src-master/gforth/gforth.el,v 1.3 1994/07/08 15:00:41 anton Exp $
-
 ;;-------------------------------------------------------------------
 ;; A Forth indentation, documentation search and interaction library
 ;;-------------------------------------------------------------------
@@ -33,21 +36,35 @@
 
 
 (defvar forth-positives
-  " : begin do ?do while if ?dup-if ?dup-not-if else case create does> exception> "
+  " : :noname code interpretation: ;code does> begin do ?do +do -do u+do u-do while if ?dup-if ?dup-0=-if else case of struct [if] [ifdef] [ifundef] [else] with public: private: class "
   "Contains all words which will cause the indent-level to be incremented
 on the next line.
 OBS! All words in forth-positives must be surrounded by spaces.")
 
 (defvar forth-negatives
-  " ; until repeat while +loop loop else then endif again endcase does> "
+  " ; end-code ;code does> until repeat while +loop loop -loop s+loop else then endif again endcase endof end-struct [then] [else] [endif] endwith class; how: "
   "Contains all words which will cause the indent-level to be decremented
 on the current line.
 OBS! All words in forth-negatives must be surrounded by spaces.")
 
 (defvar forth-zeroes
-  " : "
+  " : :noname code interpretation: public: private: how: implements class class; "
   "Contains all words which causes the indent to go to zero")
 
+(setq forth-zero 0)
+
+(defvar forth-zup
+  " how: implements "
+  "Contains all words which causes zero indent level to change")
+
+(defvar forth-zdown
+  " class; how: class public: private: "
+  "Contains all words which causes zero indent level to change")
+
+(defvar forth-prefixes
+  " postpone [compile] ['] [char] "
+  "words that prefix and escape other words")
+
 (defvar forth-mode-abbrev-table nil
   "Abbrev table in use in Forth-mode buffers.")
 
@@ -59,16 +76,24 @@ OBS! All words in forth-negatives must b
 (if (not forth-mode-map)
     (setq forth-mode-map (make-sparse-keymap)))
 
-(global-set-key "\e\C-m" 'forth-send-paragraph)
-(global-set-key "\C-x\C-m" 'forth-split)
-(global-set-key "\e " 'forth-reload)
-
+;(define-key forth-mode-map "\M-\C-x" 'compile)
+(define-key forth-mode-map "\C-x\\" 'comment-region)
+(define-key forth-mode-map "\C-x~" 'forth-remove-tracers)
 (define-key forth-mode-map "\e\C-m" 'forth-send-paragraph)
 (define-key forth-mode-map "\eo" 'forth-send-buffer)
 (define-key forth-mode-map "\C-x\C-m" 'forth-split)
 (define-key forth-mode-map "\e " 'forth-reload)
 (define-key forth-mode-map "\t" 'forth-indent-command)
 (define-key forth-mode-map "\C-m" 'reindent-then-newline-and-indent)
+(define-key forth-mode-map "\M-q" 'forth-fill-paragraph)
+(define-key forth-mode-map "\e." 'forth-find-tag)
+
+(load "etags")
+
+(defun forth-find-tag (tagname &optional next-p regexp-p)
+  (interactive (find-tag-interactive "Find tag: "))
+  (switch-to-buffer
+   (find-tag-noselect (concat " " tagname " ") next-p regexp-p)))
 
 (defvar forth-mode-syntax-table nil
   "Syntax table in use in Forth-mode buffers.")
@@ -76,23 +101,28 @@ OBS! All words in forth-negatives must b
 (if (not forth-mode-syntax-table)
     (progn
       (setq forth-mode-syntax-table (make-syntax-table))
-      (modify-syntax-entry ?\\ "\\" forth-mode-syntax-table)
-      (modify-syntax-entry ?/ ". 14" forth-mode-syntax-table)
-      (modify-syntax-entry ?* ". 23" forth-mode-syntax-table)
-      (modify-syntax-entry ?+ "." forth-mode-syntax-table)
-      (modify-syntax-entry ?- "." forth-mode-syntax-table)
-      (modify-syntax-entry ?= "." forth-mode-syntax-table)
-      (modify-syntax-entry ?% "." forth-mode-syntax-table)
-      (modify-syntax-entry ?< "." forth-mode-syntax-table)
-      (modify-syntax-entry ?> "." forth-mode-syntax-table)
-      (modify-syntax-entry ?& "." forth-mode-syntax-table)
-      (modify-syntax-entry ?| "." forth-mode-syntax-table)
-      (modify-syntax-entry ?\' "\"" forth-mode-syntax-table)
-      (modify-syntax-entry ?\t "    " forth-mode-syntax-table)
-      (modify-syntax-entry ?) ">   " forth-mode-syntax-table)
-      (modify-syntax-entry ?( "<   " forth-mode-syntax-table)
-      (modify-syntax-entry ?\( "()  " forth-mode-syntax-table)
-      (modify-syntax-entry ?\) ")(  " forth-mode-syntax-table)))
+      (let ((char 0))
+	(while (< char ?!)
+	  (modify-syntax-entry char " " forth-mode-syntax-table)
+	  (setq char (1+ char)))
+	(while (< char 256)
+	  (modify-syntax-entry char "w" forth-mode-syntax-table)
+	  (setq char (1+ char))))
+      (modify-syntax-entry ?\" "\"" forth-mode-syntax-table)
+      (modify-syntax-entry ?\\ "<" forth-mode-syntax-table)
+      (modify-syntax-entry ?\n ">" forth-mode-syntax-table)
+      ))
+;I do not define '(' and ')' as comment delimiters, because emacs
+;only supports one comment syntax (and a hack to accomodate C++); I
+;use '\' for natural language comments and '(' for formal comments
+;like stack comments, so for me it's better to have emacs treat '\'
+;comments as comments. If you want it different, make the appropriate
+;changes (best in your .emacs file).
+;
+;Hmm, the C++ hack could be used to support both comment syntaxes: we
+;can have different comment styles, if both comments start with the
+;same character. we could use ' ' as first and '(' and '\' as second
+;character. However this would fail for G\ comments.
 
 (defconst forth-indent-level 4
   "Indentation of Forth statements.")
@@ -106,8 +136,8 @@ OBS! All words in forth-negatives must b
   (setq paragraph-separate paragraph-start)
   (make-local-variable 'indent-line-function)
   (setq indent-line-function 'forth-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
+;  (make-local-variable 'require-final-newline)
+;  (setq require-final-newline t)
   (make-local-variable 'comment-start)
   (setq comment-start "\\ ")
   ;(make-local-variable 'comment-end)
@@ -125,8 +155,8 @@ OBS! All words in forth-negatives must b
 (defun forth-mode ()
   "
 Major mode for editing Forth code. Tab indents for Forth code. Comments
-are delimited with ( ). Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
+are delimited with \\ and newline. Paragraphs are separated by blank lines
+only.
 \\{forth-mode-map}
  Forth-split
     Positions the current buffer on top and a forth-interaction window
@@ -197,6 +227,34 @@ Variables controling documentation searc
 ;      (run-forth forth-program-name))
   (run-hooks 'forth-mode-hook))
 
+(setq forth-mode-hook
+      '(lambda () 
+	 (make-local-variable 'compile-command)
+	 (setq compile-command "gforth ")))
+
+(defun forth-fill-paragraph () 
+  "Fill comments (starting with '\'; do not fill code (block style
+programmers who tend to fill code won't use emacs anyway:-)."
+  ; Currently only comments at the start of the line are filled.
+  ; Something like lisp-fill-paragraph may be better.  We cannot use
+  ; fill-paragraph, because it removes the \ from the first comment
+  ; line. Therefore we have to look for the first line of the comment
+  ; and use fill-region.
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (while (and
+	     (= (forward-line -1) 0)
+	     (looking-at "[ \t]*\\\\g?[ \t]+")))
+    (if (not (looking-at "[ \t]*\\\\g?[ \t]+"))
+	(forward-line 1))
+    (let ((from (point))
+	  (to (save-excursion (forward-paragraph) (point))))
+      (if (looking-at "[ \t]*\\\\g?[ \t]+")
+	  (progn (goto-char (match-end 0))
+		 (set-fill-prefix)
+		 (fill-region from to nil))))))
+
 (defun forth-comment-indent ()
   (save-excursion
     (beginning-of-line)
@@ -266,8 +324,12 @@ Variables controling documentation searc
 			 (regexp-quote (concat " " w1 " "))
 			 forth-negatives)
 			forth-indent-level 0)))
+    (if (string-match (regexp-quote (concat " " w1 " ")) forth-zdown)
+	(setq forth-zero 0))
     (if (string-match (regexp-quote (concat " " w1 " ")) forth-zeroes)
-	(setq indent 0))
+	(setq indent forth-zero))
+    (if (string-match (regexp-quote (concat " " w1 " ")) forth-zup)
+	(setq forth-zero 4))
     indent))
 
 (defun forth-sum-line-indentation ()
@@ -281,8 +343,6 @@ Variables controling documentation searc
 			     forth-positives))
       (setq t2 (string-match (regexp-quote (concat " " w " "))
 			     forth-negatives))
-      (if (and t1 t2)
-	  (setq sum (+ sum forth-indent-level)))
       (if t1
 	  (setq sum (+ sum forth-indent-level)))
       (if (and t2 (not first))
@@ -293,7 +353,10 @@ Variables controling documentation searc
 
 
 (defun forth-next-word ()
-  "Return the next forth-word. Skip anything enclosed in double quotes or ()."
+  "Return the next forth-word. Skip anything that the forth-word takes from
+the input stream (comments, arguments, etc.)"
+;actually, it would be better to use commands based on the
+;syntax-table or comment-start etc.
   (let ((w1 nil))
     (while (not w1)
       (skip-chars-forward " \t\n")
@@ -302,19 +365,31 @@ Variables controling documentation searc
 	(setq w1 (buffer-substring p (point))))
       (cond ((string-match "\"" w1)
 	     (progn
-	       (skip-chars-forward "^\"")
-	       (setq w1 nil)))
-	    ((string-match "\(" w1)
+	       (skip-chars-forward "^\"\n")
+	       (forward-char)))
+	    ((string-match "\\\\" w1)
+	     (progn
+	       (end-of-line)
+	       ))
+	    ((or (equal "(" w1) (equal ".(" w1))
 	     (progn
-	       (skip-chars-forward "^\)")
-	       (setq w1 nil)))
+	       (skip-chars-forward "^)\n")
+	       (forward-char)))
+	    ((string-match (regexp-quote (concat " " w1 " ")) forth-prefixes)
+	     (progn (skip-chars-forward " \t\n")
+		    (skip-chars-forward "^ \t\n")))
 	    (t nil)))
     w1))
       
 
 ;; Forth commands
 
-(defvar forth-program-name "forth"
+(defun forth-remove-tracers ()
+  "Remove tracers of the form `~~ '. Queries the user for each occurrence."
+  (interactive)
+  (query-replace-regexp "\\(~~ \\| ~~$\\)" "" nil))
+
+(defvar forth-program-name "gforth"
   "*Program invoked by the `run-forth' command.")
 
 (defvar forth-band-name nil
@@ -342,6 +417,10 @@ part of the screen."
   (forth-split)
   (forth-set-runlight forth-runlight:input))
 
+(defun run-forth-if-not ()
+  (if (not (forth-process-running-p))
+      (run-forth forth-program-name)))
+
 (defun reset-forth ()
   "Reset the Forth process."
   (interactive)
@@ -355,12 +434,9 @@ part of the screen."
 	   (message "Resetting Forth process...done")))))
 
 (defun forth-default-command-line ()
-  (concat forth-program-name " -emacs"
+  (concat forth-program-name
 	  (if forth-program-arguments
 	      (concat " " forth-program-arguments)
-	      "")
-	  (if forth-band-name
-	      (concat " -band " forth-band-name)
 	      "")))
 
 ;;;; Internal Variables
@@ -384,7 +460,7 @@ When called, the current buffer will be
 (defvar forth-signal-death-message nil
   "If non-nil, causes a message to be generated when the Forth process dies.")
 
-(defvar forth-percent-height 62
+(defvar forth-percent-height 50
   "Tells run-forth how high the upper window should be in percent.")
 
 (defconst forth-runlight:input ?I
@@ -617,7 +693,7 @@ The region is sent terminated by a newli
 ;; Misc
 
 (setq auto-mode-alist (append auto-mode-alist
-				'(("\\.f83$" . forth-mode))))
+				'(("\\.fs$" . forth-mode))))
 
 (defun forth-split ()
   (interactive)
@@ -638,7 +714,7 @@ The region is sent terminated by a newli
   (interactive)
   (let ((process (get-process forth-program-name)))
     (if process (kill-process process t)))
-  (sleep-for-millisecs 100)
+  (sleep-for 0 100)
   (forth-mode))
 
 
@@ -689,7 +765,7 @@ The region is sent terminated by a newli
     (error "forth-help-load-path not specified")))
 
 
-(define-key forth-mode-map "\C-hf" 'forth-documentation)
+;(define-key forth-mode-map "\C-hf" 'forth-documentation)
 
 (defun forth-documentation (function)
   "Display the full documentation of FORTH word."
@@ -793,12 +869,12 @@ The region is sent terminated by a newli
     res))
 
 
-(define-key forth-mode-map "\C-x\C-e" 'forth-compile)
+(define-key forth-mode-map "\C-x\C-e" 'compile)
 (define-key forth-mode-map "\C-x\C-n" 'next-error)
 (require 'compile "compile")
 
-(defvar forth-compile-command "forth ")
-(defvar forth-compilation-window-percent-height 30)
+(defvar forth-compile-command "gforth ")
+;(defvar forth-compilation-window-percent-height 30)
 
 (defun forth-compile (command)
   (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command))))
@@ -807,3 +883,98 @@ The region is sent terminated by a newli
   (compile1 ctools-compile-command "No more errors"))
 
 
+;;; Forth menu
+;;; Mikael Karlsson <qramika@eras70.ericsson.se>
+
+(cond ((string-match "XEmacs\\|Lucid" emacs-version)
+       (require 'func-menu)
+
+  (defconst fume-function-name-regexp-forth
+   "^\\(:\\)[ \t]+\\([^ \t]*\\)"
+   "Expression to get word definitions in Forth.")
+
+  (setq fume-function-name-regexp-alist
+      (append '((forth-mode . fume-function-name-regexp-forth) 
+             ) fume-function-name-regexp-alist))
+
+  ;; Find next forth word in the buffer
+  (defun fume-find-next-forth-function-name (buffer)
+    "Searches for the next forth word in BUFFER."
+    (set-buffer buffer)
+    (if (re-search-forward fume-function-name-regexp nil t)
+      (let ((beg (match-beginning 2))
+            (end (match-end 2)))
+        (cons (buffer-substring beg end) beg))))
+
+  (setq fume-find-function-name-method-alist
+  (append '((forth-mode    . fume-find-next-forth-function-name))))
+
+  ))
+;;; End Forth menu
+
+;;; File folding of forth-files
+;;; uses outline
+;;; Toggle activation with M-x fold-f (when editing a forth-file) 
+;;; Use f9 to expand, f10 to hide, Or the menubar in xemacs
+;;;
+;;; Works most of the times but loses sync with the cursor occasionally 
+;;; Could be improved by also folding on comments
+
+(require 'outline)
+
+(defun f-outline-level ()
+	(cond	((looking-at "\\`\\\\")
+			0)
+		((looking-at "\\\\ SEC")
+			0)
+		((looking-at "\\\\ \\\\ .*")
+			0)
+		((looking-at "\\\\ DEFS")
+			1)
+		((looking-at "\\/\\* ")
+			1)
+		((looking-at ": .*")
+			1)
+		((looking-at "\\\\G")
+			2)
+		((looking-at "[ \t]+\\\\")
+			3))
+)			
+
+(defun fold-f  ()
+   (interactive)
+   (add-hook 'outline-minor-mode-hook 'hide-body)
+
+   ; outline mode header start, i.e. find word definitions
+;;;   (setq  outline-regexp  "^\\(:\\)[ \t]+\\([^ \t]*\\)")
+   (setq  outline-regexp  "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*")
+   (setq outline-level 'f-outline-level)
+
+   (outline-minor-mode)
+   (define-key outline-minor-mode-map '(shift up) 'hide-sublevels)
+   (define-key outline-minor-mode-map '(shift right) 'show-children)
+   (define-key outline-minor-mode-map '(shift left) 'hide-subtree)
+   (define-key outline-minor-mode-map '(shift down) 'show-subtree)
+
+)
+
+;;(define-key global-map '(shift up) 'fold-f)
+
+;;; end file folding
+
+;;; func-menu is a package that scans your source file for function definitions
+;;; and makes a menubar entry that lets you jump to any particular function
+;;; definition by selecting it from the menu.  The following code turns this on
+;;; for all of the recognized languages.  Scanning the buffer takes some time,
+;;; but not much.
+;;;
+(cond ((string-match "XEmacs\\|Lucid" emacs-version)
+       (require 'func-menu)
+;;       (define-key global-map 'f8 'function-menu)
+       (add-hook 'find-fible-hooks 'fume-add-menubar-entry)
+;       (define-key global-map "\C-cg" 'fume-prompt-function-goto)
+;       (define-key global-map '(shift button3) 'mouse-function-menu)
+))
+
+;; end
+