Diff for /gforth/gforth.el between versions 1.2 and 1.24

version 1.2, 1994/06/17 12:35:01 version 1.24, 1997/10/04 17:33:52
Line 1 Line 1
 ;; This file is part of GNU Emacs.  ;; Forth mode for Emacs
   ;; This file is part of GForth.
 ;; Changes by anton  ;; 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  ;; but WITHOUT ANY WARRANTY.  No author or distributor
 ;; accepts responsibility to anyone for the consequences of using it  ;; accepts responsibility to anyone for the consequences of using it
 ;; or for whether it serves any particular purpose or works at all,  ;; or for whether it serves any particular purpose or works at all,
Line 11 Line 16
 ;; Everyone is granted permission to copy, modify and redistribute  ;; Everyone is granted permission to copy, modify and redistribute
 ;; GNU Emacs, but only under the conditions described in the  ;; GNU Emacs, but only under the conditions described in the
 ;; GNU Emacs General Public License.   A copy of this license is  ;; 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  ;; can know your rights and responsibilities.  It should be in a
 ;; file named COPYING.  Among other things, the copyright notice  ;; file named COPYING.  Among other things, the copyright notice
 ;; and this notice must be preserved on all copies.  ;; and this notice must be preserved on all copies.
   
 ;;; $Header$  
   
 ;;-------------------------------------------------------------------  ;;-------------------------------------------------------------------
 ;; A Forth indentation, documentation search and interaction library  ;; A Forth indentation, documentation search and interaction library
 ;;-------------------------------------------------------------------  ;;-------------------------------------------------------------------
Line 33 Line 36
   
   
 (defvar forth-positives  (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    "Contains all words which will cause the indent-level to be incremented
 on the next line.  on the next line.
 OBS! All words in forth-positives must be surrounded by spaces.")  OBS! All words in forth-positives must be surrounded by spaces.")
   
 (defvar forth-negatives  (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    "Contains all words which will cause the indent-level to be decremented
 on the current line.  on the current line.
 OBS! All words in forth-negatives must be surrounded by spaces.")  OBS! All words in forth-negatives must be surrounded by spaces.")
   
 (defvar forth-zeroes  (defvar forth-zeroes
   " : "    " : :noname code interpretation: public: private: how: class class; "
   "Contains all words which causes the indent to go to zero")    "Contains all words which causes the indent to go to zero")
   
   (setq forth-zero 0)
   
   (defvar forth-zup
     " how: "
     "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  (defvar forth-mode-abbrev-table nil
   "Abbrev table in use in Forth-mode buffers.")    "Abbrev table in use in Forth-mode buffers.")
   
Line 59  OBS! All words in forth-negatives must b Line 76  OBS! All words in forth-negatives must b
 (if (not forth-mode-map)  (if (not forth-mode-map)
     (setq forth-mode-map (make-sparse-keymap)))      (setq forth-mode-map (make-sparse-keymap)))
   
 (global-set-key "\e\C-m" 'forth-send-paragraph)  ;(define-key forth-mode-map "\M-\C-x" 'compile)
 (global-set-key "\C-x\C-m" 'forth-split)  (define-key forth-mode-map "\C-x\\" 'comment-region)
 (global-set-key "\e " 'forth-reload)  (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 "\e\C-m" 'forth-send-paragraph)
 (define-key forth-mode-map "\eo" 'forth-send-buffer)  (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 "\C-x\C-m" 'forth-split)
 (define-key forth-mode-map "\e " 'forth-reload)  (define-key forth-mode-map "\e " 'forth-reload)
 (define-key forth-mode-map "\t" 'forth-indent-command)  (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 "\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  (defvar forth-mode-syntax-table nil
   "Syntax table in use in Forth-mode buffers.")    "Syntax table in use in Forth-mode buffers.")
Line 76  OBS! All words in forth-negatives must b Line 101  OBS! All words in forth-negatives must b
 (if (not forth-mode-syntax-table)  (if (not forth-mode-syntax-table)
     (progn      (progn
       (setq forth-mode-syntax-table (make-syntax-table))        (setq forth-mode-syntax-table (make-syntax-table))
       (modify-syntax-entry ?\\ "\\" forth-mode-syntax-table)        (let ((char 0))
       (modify-syntax-entry ?/ ". 14" forth-mode-syntax-table)          (while (< char ?!)
       (modify-syntax-entry ?* ". 23" forth-mode-syntax-table)            (modify-syntax-entry char " " forth-mode-syntax-table)
       (modify-syntax-entry ?+ "." forth-mode-syntax-table)            (setq char (1+ char)))
       (modify-syntax-entry ?- "." forth-mode-syntax-table)          (while (< char 256)
       (modify-syntax-entry ?= "." forth-mode-syntax-table)            (modify-syntax-entry char "w" forth-mode-syntax-table)
       (modify-syntax-entry ?% "." 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 ?> "." forth-mode-syntax-table)        (modify-syntax-entry ?\\ "<" forth-mode-syntax-table)
       (modify-syntax-entry ?& "." forth-mode-syntax-table)        (modify-syntax-entry ?\n ">" forth-mode-syntax-table)
       (modify-syntax-entry ?| "." forth-mode-syntax-table)        ))
       (modify-syntax-entry ?\' "\"" forth-mode-syntax-table)  ;I do not define '(' and ')' as comment delimiters, because emacs
       (modify-syntax-entry ?\t "    " forth-mode-syntax-table)  ;only supports one comment syntax (and a hack to accomodate C++); I
       (modify-syntax-entry ?) ">   " forth-mode-syntax-table)  ;use '\' for natural language comments and '(' for formal comments
       (modify-syntax-entry ?( "<   " forth-mode-syntax-table)  ;like stack comments, so for me it's better to have emacs treat '\'
       (modify-syntax-entry ?\( "()  " forth-mode-syntax-table)  ;comments as comments. If you want it different, make the appropriate
       (modify-syntax-entry ?\) ")(  " forth-mode-syntax-table)))  ;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  (defconst forth-indent-level 4
   "Indentation of Forth statements.")    "Indentation of Forth statements.")
Line 106  OBS! All words in forth-negatives must b Line 136  OBS! All words in forth-negatives must b
   (setq paragraph-separate paragraph-start)    (setq paragraph-separate paragraph-start)
   (make-local-variable 'indent-line-function)    (make-local-variable 'indent-line-function)
   (setq indent-line-function 'forth-indent-line)    (setq indent-line-function 'forth-indent-line)
   (make-local-variable 'require-final-newline)  ;  (make-local-variable 'require-final-newline)
   (setq require-final-newline t)  ;  (setq require-final-newline t)
   (make-local-variable 'comment-start)    (make-local-variable 'comment-start)
   (setq comment-start "( ")    (setq comment-start "\\ ")
   (make-local-variable 'comment-end)    ;(make-local-variable 'comment-end)
   (setq comment-end " )")    ;(setq comment-end " )")
   (make-local-variable 'comment-column)    (make-local-variable 'comment-column)
   (setq comment-column 40)    (setq comment-column 40)
   (make-local-variable 'comment-start-skip)    (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "( ")    (setq comment-start-skip "\\ ")
   (make-local-variable 'comment-indent-hook)    (make-local-variable 'comment-indent-hook)
   (setq comment-indent-hook 'forth-comment-indent)    (setq comment-indent-hook 'forth-comment-indent)
   (make-local-variable 'parse-sexp-ignore-comments)    (make-local-variable 'parse-sexp-ignore-comments)
Line 125  OBS! All words in forth-negatives must b Line 155  OBS! All words in forth-negatives must b
 (defun forth-mode ()  (defun forth-mode ()
   "    "
 Major mode for editing Forth code. Tab indents for Forth code. Comments  Major mode for editing Forth code. Tab indents for Forth code. Comments
 are delimited with ( ). Paragraphs are separated by blank lines only.  are delimited with \\ and newline. Paragraphs are separated by blank lines
 Delete converts tabs to spaces as it moves back.  only.
 \\{forth-mode-map}  \\{forth-mode-map}
  Forth-split   Forth-split
     Positions the current buffer on top and a forth-interaction window      Positions the current buffer on top and a forth-interaction window
Line 197  Variables controling documentation searc Line 227  Variables controling documentation searc
 ;      (run-forth forth-program-name))  ;      (run-forth forth-program-name))
   (run-hooks 'forth-mode-hook))    (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 ()  (defun forth-comment-indent ()
   (save-excursion    (save-excursion
     (beginning-of-line)      (beginning-of-line)
Line 266  Variables controling documentation searc Line 324  Variables controling documentation searc
                          (regexp-quote (concat " " w1 " "))                           (regexp-quote (concat " " w1 " "))
                          forth-negatives)                           forth-negatives)
                         forth-indent-level 0)))                          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)      (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))      indent))
   
 (defun forth-sum-line-indentation ()  (defun forth-sum-line-indentation ()
Line 281  Variables controling documentation searc Line 343  Variables controling documentation searc
                              forth-positives))                               forth-positives))
       (setq t2 (string-match (regexp-quote (concat " " w " "))        (setq t2 (string-match (regexp-quote (concat " " w " "))
                              forth-negatives))                               forth-negatives))
       (if (and t1 t2)  
           (setq sum (+ sum forth-indent-level)))  
       (if t1        (if t1
           (setq sum (+ sum forth-indent-level)))            (setq sum (+ sum forth-indent-level)))
       (if (and t2 (not first))        (if (and t2 (not first))
Line 293  Variables controling documentation searc Line 353  Variables controling documentation searc
   
   
 (defun forth-next-word ()  (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))    (let ((w1 nil))
     (while (not w1)      (while (not w1)
       (skip-chars-forward " \t\n")        (skip-chars-forward " \t\n")
Line 302  Variables controling documentation searc Line 365  Variables controling documentation searc
         (setq w1 (buffer-substring p (point))))          (setq w1 (buffer-substring p (point))))
       (cond ((string-match "\"" w1)        (cond ((string-match "\"" w1)
              (progn               (progn
                (skip-chars-forward "^\"")                 (skip-chars-forward "^\"\n")
                (setq w1 nil)))                 (forward-char)))
             ((string-match "\(" w1)              ((string-match "\\\\" w1)
                (progn
                  (end-of-line)
                  ))
               ((or (equal "(" w1) (equal ".(" w1))
              (progn               (progn
                (skip-chars-forward "^\)")                 (skip-chars-forward "^)\n")
                (setq w1 nil)))                 (forward-char)))
               ((string-match (regexp-quote (concat " " w1 " ")) forth-prefixes)
                (progn (skip-chars-forward " \t\n")
                       (skip-chars-forward "^ \t\n")))
             (t nil)))              (t nil)))
     w1))      w1))
               
   
 ;; Forth commands  ;; 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.")    "*Program invoked by the `run-forth' command.")
   
 (defvar forth-band-name nil  (defvar forth-band-name nil
Line 355  part of the screen." Line 430  part of the screen."
            (message "Resetting Forth process...done")))))             (message "Resetting Forth process...done")))))
   
 (defun forth-default-command-line ()  (defun forth-default-command-line ()
   (concat forth-program-name " -emacs"    (concat forth-program-name
           (if forth-program-arguments            (if forth-program-arguments
               (concat " " forth-program-arguments)                (concat " " forth-program-arguments)
               "")  
           (if forth-band-name  
               (concat " -band " forth-band-name)  
               "")))                "")))
   
 ;;;; Internal Variables  ;;;; Internal Variables
Line 384  When called, the current buffer will be Line 456  When called, the current buffer will be
 (defvar forth-signal-death-message nil  (defvar forth-signal-death-message nil
   "If non-nil, causes a message to be generated when the Forth process dies.")    "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.")    "Tells run-forth how high the upper window should be in percent.")
   
 (defconst forth-runlight:input ?I  (defconst forth-runlight:input ?I
Line 617  The region is sent terminated by a newli Line 689  The region is sent terminated by a newli
 ;; Misc  ;; Misc
   
 (setq auto-mode-alist (append auto-mode-alist  (setq auto-mode-alist (append auto-mode-alist
                                 '(("\\.f83$" . forth-mode))))                                  '(("\\.fs$" . forth-mode))))
   
 (defun forth-split ()  (defun forth-split ()
   (interactive)    (interactive)
Line 689  The region is sent terminated by a newli Line 761  The region is sent terminated by a newli
     (error "forth-help-load-path not specified")))      (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)  (defun forth-documentation (function)
   "Display the full documentation of FORTH word."    "Display the full documentation of FORTH word."
Line 793  The region is sent terminated by a newli Line 865  The region is sent terminated by a newli
     res))      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)  (define-key forth-mode-map "\C-x\C-n" 'next-error)
 (require 'compile "compile")  (require 'compile "compile")
   
 (defvar forth-compile-command "forth ")  (defvar forth-compile-command "gforth ")
 (defvar forth-compilation-window-percent-height 30)  ;(defvar forth-compilation-window-percent-height 30)
   
 (defun forth-compile (command)  (defun forth-compile (command)
   (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command))))    (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command))))
Line 807  The region is sent terminated by a newli Line 879  The region is sent terminated by a newli
   (compile1 ctools-compile-command "No more errors"))    (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)
   
   ;;(define-key outline-minor-mode-map 'f9 'show-entry)
   ;;(define-key outline-minor-mode-map 'f10 'hide-entry)
   
   (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]*\\)")
   
      (outline-minor-mode)
   )
   ;;; 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)
          ))

Removed from v.1.2  
changed lines
  Added in v.1.24


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>