Diff for /gforth/gforth.el between versions 1.21 and 1.47

version 1.21, 1997/03/25 23:27:12 version 1.47, 2001/03/11 22:50:49
Line 1 Line 1
 ;; Forth mode for Emacs  ;; Forth mode for Emacs
 ;; This file is part of GForth.  
 ;; Changes by anton  ;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
 ;; 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   ;; This file is part of Gforth.
 ;; the things I use (mainly indentation and syntax tables).  
 ;; So there is still a lot of work to do to adapt this to gforth.  
   
 ;; GForth 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
Line 21 Line 19
 ;; 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.
   
   ;; 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.
   
 ;;-------------------------------------------------------------------  ;;-------------------------------------------------------------------
 ;; A Forth indentation, documentation search and interaction library  ;; A Forth indentation, documentation search and interaction library
 ;;-------------------------------------------------------------------  ;;-------------------------------------------------------------------
Line 36 Line 40
   
   
 (defvar forth-positives  (defvar forth-positives
   " : :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] [else] with public: private: class "    " : :noname m: :m 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 try recover "
   "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
   " ; 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: "    " ; ;m end-code ;code does> until repeat while +loop loop -loop s+loop else then endif again endcase endof end-struct [then] [else] [endif] endwith end-class class; how: recover endtry "
   "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; "    " : :noname code interpretation: public: private: how: implements 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)  (setq forth-zero 0)
   
 (defvar forth-zup  (defvar forth-zup
   " how: "    " how: implements "
   "Contains all words which causes zero indent level to change")    "Contains all words which causes zero indent level to change")
   
 (defvar forth-zdown  (defvar forth-zdown
Line 76  OBS! All words in forth-negatives must b Line 80  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)  
 (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 "\M-\C-x" 'compile)
 (define-key forth-mode-map "\C-x\\" 'comment-region)  (define-key forth-mode-map "\C-x\\" 'comment-region)
 (define-key forth-mode-map "\C-x~" 'forth-remove-tracers)  (define-key forth-mode-map "\C-x~" 'forth-remove-tracers)
Line 92  OBS! All words in forth-negatives must b Line 92  OBS! All words in forth-negatives must b
 (define-key forth-mode-map "\M-q" 'forth-fill-paragraph)  (define-key forth-mode-map "\M-q" 'forth-fill-paragraph)
 (define-key forth-mode-map "\e." 'forth-find-tag)  (define-key forth-mode-map "\e." 'forth-find-tag)
   
 (load "etags.el")  ;setup for C-h C-i to work
   (if (fboundp 'info-lookup-add-help)
       (info-lookup-add-help
        :topic 'symbol
        :mode 'forth-mode
        :regexp "[^        
   ]+"
        :ignore-case t
        :doc-spec '(("(gforth)Name Index" nil "`" "'  "))))
   
   (load "etags")
   
 (defun forth-find-tag (tagname &optional next-p regexp-p)  (defun forth-find-tag (tagname &optional next-p regexp-p)
   (interactive (find-tag-interactive "Find tag: "))    (interactive (find-tag-interactive "Find tag: "))
Line 102  OBS! All words in forth-negatives must b Line 112  OBS! All words in forth-negatives must b
 (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.")
   
 (if (not forth-mode-syntax-table)  (if t;; (not forth-mode-syntax-table)
     (progn      (progn
       (setq forth-mode-syntax-table (make-syntax-table))        (setq forth-mode-syntax-table (make-syntax-table))
       (let ((char 0))        (let ((char 0))
Line 113  OBS! All words in forth-negatives must b Line 123  OBS! All words in forth-negatives must b
           (modify-syntax-entry char "w" forth-mode-syntax-table)            (modify-syntax-entry char "w" forth-mode-syntax-table)
           (setq char (1+ char))))            (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 ?\n ">" forth-mode-syntax-table)  
       ))        ))
 ;I do not define '(' and ')' as comment delimiters, because emacs  ;I do not define '(' and ')' as comment delimiters, because emacs
 ;only supports one comment syntax (and a hack to accomodate C++); I  ;only supports one comment syntax (and a hack to accomodate C++); I
Line 128  OBS! All words in forth-negatives must b Line 136  OBS! All words in forth-negatives must b
 ;same character. we could use ' ' as first and '(' and '\' as second  ;same character. we could use ' ' as first and '(' and '\' as second
 ;character. However this would fail for G\ comments.  ;character. However this would fail for G\ comments.
   
   ;comment handling has been moved to syntactic font lock (david)
   
 (defconst forth-indent-level 4  (defconst forth-indent-level 4
   "Indentation of Forth statements.")    "Indentation of Forth statements.")
   
Line 153  OBS! All words in forth-negatives must b Line 163  OBS! All words in forth-negatives must b
   (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)
   (setq parse-sexp-ignore-comments t))    (setq parse-sexp-ignore-comments t)
     (make-local-variable 'font-lock-defaults)
     (setq font-lock-defaults '(forth-font-lock-keywords nil t nil nil
         (font-lock-syntactic-keywords . forth-font-lock-syntactic-keywords)))
   ;  (make-local-variable 'font-lock-syntactic-keywords)
   ;  (setq font-lock-syntactic-keywords 'forth-font-lock-syntactic-keywords)
   )
   
       
 ;;;###autoload  ;;;###autoload
 (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 \\ and newline. Paragraphs are separated by blank lines  are delimited with \\ and newline. Paragraphs are separated by blank lines
 only. 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 231  Variables controling documentation searc Line 248  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  (add-hook 'forth-mode-hook
       '(lambda ()         '(lambda () 
          (make-local-variable 'compile-command)           (make-local-variable 'compile-command)
          (setq compile-command "gforth ")))           (setq compile-command "gforth ")))
Line 421  part of the screen." Line 438  part of the screen."
   (forth-split)    (forth-split)
   (forth-set-runlight forth-runlight:input))    (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 ()  (defun reset-forth ()
   "Reset the Forth process."    "Reset the Forth process."
   (interactive)    (interactive)
Line 714  The region is sent terminated by a newli Line 735  The region is sent terminated by a newli
   (interactive)    (interactive)
   (let ((process (get-process forth-program-name)))    (let ((process (get-process forth-program-name)))
     (if process (kill-process process t)))      (if process (kill-process process t)))
   (sleep-for-millisecs 100)    (sleep-for 0 100)
   (forth-mode))    (forth-mode))
   
   
Line 922  The region is sent terminated by a newli Line 943  The region is sent terminated by a newli
   
 (require 'outline)  (require 'outline)
   
 ;;(define-key outline-minor-mode-map 'f9 'show-entry)  (defun f-outline-level ()
 ;;(define-key outline-minor-mode-map 'f10 'hide-entry)          (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  ()  (defun fold-f  ()
    (interactive)     (interactive)
    (add-hook 'outline-minor-mode-hook 'hide-body)     (add-hook 'outline-minor-mode-hook 'hide-body)
   
    ; outline mode header start, i.e. find word definitions     ; outline mode header start, i.e. find word definitions
    (setq  outline-regexp  "^\\(:\\)[ \t]+\\([^ \t]*\\)")  ;;;   (setq  outline-regexp  "^\\(:\\)[ \t]+\\([^ \t]*\\)")
      (setq  outline-regexp  "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*")
      (setq outline-level 'f-outline-level)
   
    (outline-minor-mode)     (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  ;;; end file folding
   
 ;;; func-menu is a package that scans your source file for function definitions  ;;; func-menu is a package that scans your source file for function definitions
Line 946  The region is sent terminated by a newli Line 993  The region is sent terminated by a newli
        (require 'func-menu)         (require 'func-menu)
 ;;       (define-key global-map 'f8 'function-menu)  ;;       (define-key global-map 'f8 'function-menu)
        (add-hook 'find-fible-hooks 'fume-add-menubar-entry)         (add-hook 'find-fible-hooks 'fume-add-menubar-entry)
        (define-key global-map "\C-cg" 'fume-prompt-function-goto)  ;       (define-key global-map "\C-cg" 'fume-prompt-function-goto)
        (define-key global-map '(shift button3) 'mouse-function-menu)  ;       (define-key global-map '(shift button3) 'mouse-function-menu)
   ))
   
   ;;; Font lock code                              (david <dvdkhlng@gmx.de>)
   ;;;
   ;;; note that words which contain a closing paren, which have the comment-ender
   ;;; syntactic class, won't be matched by `\w+' and `\<' and `\>' won't work
   ;;; either; solution: use of `\S-' and `\s-' where necessary
   ;;;
   (defvar forth-bracket-keyword nil)
   (defvar forth-syntactic-keywords nil)
   (defvar forth-variable-defining-words nil)
   (defvar forth-function-defining-words nil)
   (defvar forth-function-parsing-words nil)
   (defvar forth-variable-parsing-words nil)
   (defvar forth-word-string-parsing-words nil)
   (defvar forth-type-defining-words nil)
   (defvar forth-font-lock-keywords nil)
   
   (setq forth-bracket-keywords 
         '("[if]" "[ifdef]" "[ifundef]" "[else]" "[then]" "[?do]" "[do]" "[for]" 
           "[loop]" "[+loop]" "[next]" "[begin]" "[until]" "[again]" "[while]" 
           "[repeat]"))
   (setq forth-syntactic-keywords
         '("if" "else" "then" "case" "endcase" "of" "endof" "begin" "while"
           "repeat" "until" "again" "does>" "?do" "do" "+loop" "unloop" "loop"
           "exit" "u+do" "-do" "u-do" "-loop" "u+do" "for" "next" "cs-roll"
           "cs-pick" "recurse" "?dup-if" "?dup-0=-if" "leave" "?leave" "done"
           ";" ":noname" "immediate" "restrict" "compile-only" "interpretation>"
           "<interpretation" "compilation>" "<compilation" ";code" "end-code"
           "ahead" "struct"))
   (setq forth-variable-defining-words
         '("variable" "constant" "value" "2variable" "2constant" "2value"
           "fvariable" "fconstant" "field" "w:" "d:" "c:" "f:"))
   (setq forth-function-defining-words
         '(":" "defer" "alias" "interpret/compile" "code"))
   (setq forth-function-parsing-words
         '("postpone" "'" "[']" "[IS]" "IS" "<IS>"))
   (setq forth-variable-parsing-words
         '("[TO]" "TO" "<TO>"))
   (setq forth-word-string-parsing-words
         '("[CHAR]" "CHAR" "include" "require" "needs"))
   (setq forth-type-defining-words
         '("end-struct"))
   
   (defun forth-make-words-regexp (word-list)
     (concat "\\<" (regexp-opt word-list t) "\\>"))
   (defun forth-make-parsing-words-regexp (word-list)
     (concat "\\<" (regexp-opt word-list t) "\\s-+\\(\\S-+\\)"))
   (defun forth-make-parsing-words-matcher (word-list word-face parsed-face)
     (let ((regexp (forth-make-parsing-words-regexp word-list)))
       (list regexp (list 1 word-face)
             (list (regexp-opt-depth regexp) parsed-face))
       ))
         
   (setq forth-font-lock-keywords 
         (list 
          (forth-make-parsing-words-matcher forth-function-defining-words
                font-lock-keyword-face font-lock-function-name-face)
          (forth-make-parsing-words-matcher forth-variable-defining-words
                font-lock-type-face font-lock-variable-name-face)
          (forth-make-parsing-words-matcher forth-type-defining-words
                font-lock-keyword-face font-lock-type-face)
          (forth-make-parsing-words-matcher forth-function-parsing-words
                font-lock-keyword-face font-lock-function-name-face)
          (forth-make-parsing-words-matcher forth-variable-parsing-words
                font-lock-keyword-face font-lock-variable-name-face)
          (forth-make-parsing-words-matcher forth-word-string-parsing-words
                font-lock-keyword-face font-lock-string-face)
          (list (forth-make-words-regexp forth-bracket-keywords)
                0 font-lock-keyword-face)
          (list (forth-make-words-regexp forth-syntactic-keywords)
                0 font-lock-keyword-face)
   ;       '("\\<\\({\\)\\(\\([ \t]+-?[^- \t}\n]*\\>\\)*\\)\\([^}\n]*\\)\\(}\\)?"
   ;        (1 font-lock-keyword-face) (2 font-lock-variable-name-face)
   ;        (4 font-lock-comment-face) (5 font-lock-keyword-face nil t))
          '("\\<-?[0-9][0-9a-f]*\\>" . font-lock-constant-face)
          '("\\<[^ \t\n%]+%" . font-lock-type-face)
        ))         ))
   
   ;; Syntactic highlighting is used for getting Forth comments highlighted
   ;; properly: `\' and `\g' comments are handled with a single regular 
   ;; expression that parses from `\' to end of line and assigns the 
   ;; "comment-fence" generic comment delimiter to the backslash and end-of-line 
   ;; characters.
   ;; `( ... )' comments are handled by the usual comment-starter/comment-ender
   ;; syntax classes, with the extension that `(' must be a single word.
   ;; 
   (defvar forth-font-lock-syntactic-keywords nil)
   (setq forth-font-lock-syntactic-keywords
     '(("\\<\\(\\(\\\\\\)g?\\)\\>.*\\(\n\\)" (2 (14 . nil)) (3 (14 . nil)))
       ("\\<(\\>" 0 (11 . nil))
       (")" 0 (12 . nil))))
   
   ;;; End font lock code
   

Removed from v.1.21  
changed lines
  Added in v.1.47


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