[BACK]Return to gforth.el CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/gforth.el between versions 1.48 and 1.65

version 1.48, 2001/04/08 13:48:11 version 1.65, 2003/02/08 15:28:39
Line 1 Line 1
 ;;; gforth.el --- major mode for editing (G)Forth sources  ;;; gforth.el --- major mode for editing (G)Forth sources
   
 ;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.  ;; Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
   
 ;; This file is part of Gforth.  ;; This file is part of Gforth.
   
Line 33 Line 33
 ;; Changes by David  ;; Changes by David
 ;; Added a syntax-hilighting engine, rewrote auto-indentation engine.  ;; Added a syntax-hilighting engine, rewrote auto-indentation engine.
 ;; Added support for block files.  ;; Added support for block files.
   ;; Tested with Emacs 19.34, 20.5, 21.1 and XEmacs 21.1
     
 ;;-------------------------------------------------------------------  ;;-------------------------------------------------------------------
 ;; A Forth indentation, documentation search and interaction library  ;; A Forth indentation, documentation search and interaction library
Line 49 Line 50
   
 ;;; Code:  ;;; Code:
   
    ;(setq debug-on-error t)
   
   ;; Code ripped from `version.el' for compatability with Emacs versions
   ;; prior to 19.23.
   (if (not (boundp 'emacs-major-version))
       (defconst emacs-major-version
         (progn (string-match "^[0-9]+" emacs-version)
                (string-to-int (match-string 0 emacs-version)))))
   
   (defun forth-emacs-older (major minor)
     (or (< emacs-major-version major)
         (and (= emacs-major-version major) (< emacs-minor-version minor))))
   
   ;; Code ripped from `subr.el' for compatability with Emacs versions
   ;; prior to 20.1
   (eval-when-compile 
     (if (forth-emacs-older 20 1)
         (progn
           (defmacro when (cond &rest body)
             "If COND yields non-nil, do BODY, else return nil."
             (list 'if cond (cons 'progn body)))
           (defmacro unless (cond &rest body)
             "If COND yields nil, do BODY, else return nil."
             (cons 'if (cons cond (cons nil body)))))))
   
   ;; `no-error' argument of require not supported in Emacs versions
   ;; prior to 20.4 :-(
   (defun forth-require (feature)
     (condition-case err (require feature) (error nil)))
   
   (require 'font-lock)
   
   ;; define `font-lock-warning-face' in emacs-versions prior to 20.1
   ;; (ripped from `font-lock.el')
   (unless (boundp 'font-lock-warning-face)
     (message "defining font-lock-warning-face")
     (make-face 'font-lock-warning-face)
     (defvar font-lock-warning-face 'font-lock-warning-face)
     (set-face-foreground font-lock-warning-face "red")
     (make-face-bold font-lock-warning-face))
   
   ;; define `font-lock-constant-face' in XEmacs (just copy
   ;; `font-lock-preprocessor-face')
   (unless (boundp 'font-lock-constant-face)
     (copy-face font-lock-preprocessor-face 'font-lock-constant-face))
   
   
   ;; define `regexp-opt' in emacs versions prior to 20.1 
   ;; (this implementation is extremely inefficient, though)
   (eval-and-compile (forth-require 'regexp-opt))
   (unless (memq 'regexp-opt features)
     (message (concat 
               "Warning: your Emacs version doesn't support `regexp-opt'. "
               "Hilighting will be slow."))
     (defun regexp-opt (STRINGS &optional PAREN)
       (let ((open (if PAREN "\\(" "")) (close (if PAREN "\\)" "")))
         (concat open (mapconcat 'regexp-quote STRINGS "\\|") close)))
     (defun regexp-opt-depth (re)
       (if (string= (substring re 0 2) "\\(") 1 0)))
   
 ;;; Hilighting and indentation engine                           (dk)  ; todo:
   ;
   
   ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF
   ; -- mit aktueller Konzeption nicht möglich??
   ;
   ; Konfiguration über customization groups
   ;
   ; Bereich nur auf Wortanfang/ende ausweiten, wenn Anfang bzw Ende in einem 
   ; Wort liegen (?) -- speed!
   ;
   ; 'forth-word' property muss eindeutig sein!
   ;
   ; Forth-Menu 
   ;
   ; Interface zu GForth Prozessen (Patches von Michael Scholz)
   ;
   ; Byte-compile-Code rausschmeißen, Compilieren im Makefile über Emacs
   ; batch-Modus
   ;
   ; forth-help Kram rausschmeißen
   ;
   ; XEmacs Kompatibilität? imenu/speedbar -> fume?
   ; 
   ; Folding neuschreiben (neue Parser-Informationen benutzen)
   
   ;;; Motion-hooking (dk)
 ;;;  ;;;
   (defun forth-idle-function ()
     "Function that is called when Emacs is idle to detect cursor motion
   in forth-block-mode buffers (which is mainly used for screen number
   display in).  Currently ignores forth-mode buffers but that may change
   in the future."
     (if (eq major-mode 'forth-block-mode)
         (forth-check-motion)))
   
   (defvar forth-idle-function-timer nil 
     "Timer that runs `forth-idle-function' or nil if no timer installed.")
   
   (defun forth-install-motion-hook ()
     "Install the motion-hooking mechanism.  Currently uses idle timers
   but might be transparently changed in the future."
     (unless forth-idle-function-timer
       ;; install idle function only once (first time forth-mode is used)
       (setq forth-idle-function-timer 
             (run-with-idle-timer .05 t 'forth-idle-function))))
   
   (defvar forth-was-point nil)
   
   (defun forth-check-motion ()
     "Run `forth-motion-hooks', if `point' changed since last call.  This
   used to be called via `post-command-hook' but uses idle timers now as
   users complaint about lagging performance."
     (when (or (eq forth-was-point nil) (/= forth-was-point (point)))
       (setq forth-was-point (point))
       (run-hooks 'forth-motion-hooks)))
   
   
   ;;; Hilighting and indentation engine (dk)
   ;;;
   (defvar forth-disable-parser nil
     "*Non-nil means to disable on-the-fly parsing of Forth-code.
   
   This will disable hilighting of forth-mode buffers and will decrease
   the smartness of the indentation engine. Only set it to non-nil, if
   your computer is very slow. To disable hilighting, set
   `forth-hilight-level' to zero.")
   
   (defvar forth-jit-parser nil
     "*Non-nil means to parse Forth-code just-in-time.
   
   This eliminates the need for initially parsing forth-mode buffers and
   thus speeds up loading of Forth files. That feature is only available
   in Emacs21 (and newer versions).")
   
 (defvar forth-words nil   (defvar forth-words nil 
   "List of words for hilighting and recognition of parsed text areas.     "List of words for hilighting and recognition of parsed text areas. 
 You can enable hilighting of object-oriented Forth code, by appending either  
 `forth-objects-words' or `forth-oof-words' to the list, depending on which  Hilighting of object-oriented Forth code is achieved, by appending either
 OOP package you're using.  `forth-objects-words' or `forth-oof-words' to the list, depending on the values of `forth-use-objects' or `forth-use-oof'.
   
   After `forth-words' changed, `forth-compile-words' must be called to
   make the changes take effect.
   
 Each item of `forth-words' has the form   Each item of `forth-words' has the form 
    (MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...)     (MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...)
Line 131  PARSED-TYPE specifies what kind of text Line 265  PARSED-TYPE specifies what kind of text
         (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2)          (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-function-name-face . 3))           "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for"           (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for" 
           "case" "of" "?dup-if" "?dup-0=-if" "then" "until" "repeat" "again"             "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until"
             "repeat" "again" "leave" "?leave"
           "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try"            "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try"
           "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2("             "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2(" 
           "assert3(" ")" "<interpretation" "<compilation" "interpretation>"             "assert3(" ")" "<interpretation" "<compilation" "interpretation>" 
Line 140  PARSED-TYPE specifies what kind of text Line 275  PARSED-TYPE specifies what kind of text
   
         (("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w")           (("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w") 
          non-immediate (font-lock-constant-face . 2))           non-immediate (font-lock-constant-face . 2))
         (("~~") compile-only (font-lock-warning-face . 2))          (("~~" "break:" "dbg") compile-only (font-lock-warning-face . 2))
           (("break\"") compile-only (font-lock-warning-face . 1)
            "[\"\n]" nil string (font-lock-string-face . 1))
         (("postpone" "[is]" "defers" "[']" "[compile]")           (("postpone" "[is]" "defers" "[']" "[compile]") 
          compile-only (font-lock-keyword-face . 2)           compile-only (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-function-name-face . 3))           "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("is" "what's") immediate (font-lock-keyword-face . 2)          (("is" "what's") immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-function-name-face . 3))           "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("<is>" "'") non-immediate (font-lock-keyword-face . 2)          (("<is>" "'" "see") non-immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-function-name-face . 3))           "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("[to]") compile-only (font-lock-keyword-face . 2)          (("[to]") compile-only (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-variable-name-face . 3))           "[ \t\n]" t name (font-lock-variable-name-face . 3))
Line 160  PARSED-TYPE specifies what kind of text Line 297  PARSED-TYPE specifies what kind of text
           "create-interpret/compile")            "create-interpret/compile")
          non-immediate (font-lock-type-face . 2)           non-immediate (font-lock-type-face . 2)
          "[ \t\n]" t name (font-lock-variable-name-face . 3))           "[ \t\n]" t name (font-lock-variable-name-face . 3))
           ("\\S-+%" non-immediate (font-lock-type-face . 2))
         (("defer" "alias" "create-interpret/compile:")           (("defer" "alias" "create-interpret/compile:") 
          non-immediate (font-lock-type-face . 1)           non-immediate (font-lock-type-face . 1)
          "[ \t\n]" t name (font-lock-function-name-face . 3))           "[ \t\n]" t name (font-lock-function-name-face . 3))
Line 170  PARSED-TYPE specifies what kind of text Line 308  PARSED-TYPE specifies what kind of text
          immediate (font-lock-constant-face . 3))           immediate (font-lock-constant-face . 3))
         ))          ))
   
 (defvar forth-objects-words nil  (defvar forth-use-objects nil 
   "Hilighting description for words of the \"Objects\" OOP package")    "*Non-nil makes forth-mode also hilight words from the \"Objects\" package.")
 (setq forth-objects-words   (defvar forth-objects-words
       '(((":m") definition-starter (font-lock-keyword-face . 1)    '(((":m") definition-starter (font-lock-keyword-face . 1)
          "[ \t\n]" t name (font-lock-function-name-face . 3))       "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("m:") definition-starter (font-lock-keyword-face . 1))      (("m:") definition-starter (font-lock-keyword-face . 1))
         ((";m") definition-ender (font-lock-keyword-face . 1))      ((";m") definition-ender (font-lock-keyword-face . 1))
         (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1)      (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1)
          "[ \t\n]" t name (font-lock-function-name-face . 3))       "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("current" "overrides") non-immediate (font-lock-keyword-face . 2)      (("current" "overrides") non-immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-function-name-face . 3))       "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("[to-inst]") compile-only (font-lock-keyword-face . 2)      (("[to-inst]") compile-only (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-variable-name-face . 3))       "[ \t\n]" t name (font-lock-variable-name-face . 3))
         (("[bind]") compile-only (font-lock-keyword-face . 2)      (("[bind]") compile-only (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-type-face . 3)       "[ \t\n]" t name (font-lock-type-face . 3)
          "[ \t\n]" t name (font-lock-function-name-face . 3))       "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("bind") non-immediate (font-lock-keyword-face . 2)      (("bind") non-immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-type-face . 3)       "[ \t\n]" t name (font-lock-type-face . 3)
          "[ \t\n]" t name (font-lock-function-name-face . 3))       "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2)      (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2)
          "[ \t\n]" t name (font-lock-variable-name-face . 3))       "[ \t\n]" t name (font-lock-variable-name-face . 3))
         (("method" "selector")      (("method" "selector")
          non-immediate (font-lock-type-face . 1)       non-immediate (font-lock-type-face . 1)
          "[ \t\n]" t name (font-lock-function-name-face . 3))       "[ \t\n]" t name (font-lock-function-name-face . 3))
         (("end-class" "end-interface")      (("end-class" "end-interface")
          non-immediate (font-lock-keyword-face . 2)       non-immediate (font-lock-keyword-face . 2)
          "[ \t\n]" t name (font-lock-type-face . 3))       "[ \t\n]" t name (font-lock-type-face . 3))
         (("public" "protected" "class" "exitm" "implementation" "interface"      (("public" "protected" "class" "exitm" "implementation" "interface"
           "methods" "end-methods" "this")         "methods" "end-methods" "this") 
          non-immediate (font-lock-keyword-face . 2))       non-immediate (font-lock-keyword-face . 2))
         (("object") non-immediate (font-lock-type-face . 2))))      (("object") non-immediate (font-lock-type-face . 2)))
 ; (nconc forth-words forth-objects-words)    "Hilighting description for words of the \"Objects\" package")
   
 (defvar forth-oof-words nil  
   "Hilighting description for words of the \"OOF\" OOP package")  (defvar forth-use-oof nil 
 (setq forth-oof-words     "*Non-nil makes forth-mode also hilight words from the \"OOF\" package.")
       '((("class") non-immediate (font-lock-keyword-face . 2)  (defvar forth-oof-words 
          "[ \t\n]" t name (font-lock-type-face . 3))    '((("class") non-immediate (font-lock-keyword-face . 2)
         (("var") non-immediate (font-lock-type-face . 2)       "[ \t\n]" t name (font-lock-type-face . 3))
          "[ \t\n]" t name (font-lock-variable-name-face . 3))      (("var") non-immediate (font-lock-type-face . 2)
         (("method") non-immediate (font-lock-type-face . 2)       "[ \t\n]" t name (font-lock-variable-name-face . 3))
          "[ \t\n]" t name (font-lock-function-name-face . 3))      (("method" "early") non-immediate (font-lock-type-face . 2)
         (("::" "super" "bind" "bound" "link")        "[ \t\n]" t name (font-lock-function-name-face . 3))
          immediate (font-lock-keyword-face . 2)      (("::" "super" "bind" "bound" "link") 
          "[ \t\n]" t name (font-lock-function-name-face . 3))       immediate (font-lock-keyword-face . 2)
         (("ptr" "asptr" "[]")        "[ \t\n]" t name (font-lock-function-name-face . 3))
          immediate (font-lock-keyword-face . 2)      (("ptr" "asptr" "[]") 
          "[ \t\n]" t name (font-lock-variable-name-face . 3))       immediate (font-lock-keyword-face . 2)
         (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with"       "[ \t\n]" t name (font-lock-variable-name-face . 3))
           "endwith")      (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with"
          non-immediate (font-lock-keyword-face . 2))        "endwith")
         (("object") non-immediate (font-lock-type-face . 2))))       non-immediate (font-lock-keyword-face . 2))
 ; (nconc forth-words forth-oof-words)      (("object") non-immediate (font-lock-type-face . 2)))
     "Hilighting description for words of the \"OOF\" package")
   
   (defvar forth-local-words nil 
     "List of Forth words to prepend to `forth-words'. Should be set by a 
    forth source, using a local variables list at the end of the file 
    (\"Local Variables: ... forth-local-words: ... End:\" construct).") 
   
   (defvar forth-custom-words nil
     "List of Forth words to prepend to `forth-words'. Should be set in your
    .emacs.")
   
 (defvar forth-hilight-level 3 "*Level of hilighting of Forth code.")  (defvar forth-hilight-level 3 "*Level of hilighting of Forth code.")
   
 (defvar forth-compiled-words nil "Compiled representation of `forth-words'.")  (defvar forth-compiled-words nil "Compiled representation of `forth-words'.")
   
 ; todo:  (defvar forth-indent-words nil 
 ;    "List of words that have indentation behaviour.
   Each element of `forth-indent-words' should have the form
      (MATCHER INDENT1 INDENT2 &optional TYPE) 
     
   MATCHER is either a list of strings to match, or a REGEXP.
      If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since 
      that'll be done automatically by the search routines.
   
 ; Wörter ordentlich hilighten, die nicht auf whitespace beginning ( ..)IF  TYPE might be omitted. If it's specified, the only allowed value is 
 ;     currently the symbol `non-immediate', meaning that the word will not 
 ; Buffer-local variables can be set via "Local Variables:" or -*-     have any effect on indentation inside definitions. (:NONAME is a good 
 ; Setting hilighting/indentation specifications requires multi-line variables,     example for this kind of word).
 ; can only be done in 0 [IF] ... [ENDIF] blocks.  
 ; Additional variable `forth-local-words'/`forth-local-indent-words' required.  INDENT1 specifies how to indent a word that's located at the beginning
 ; Should be appended to `forth-words'. Additional `forth-use-objects' or     of a line, following any number of whitespaces.
 ; `forth-use-oof' could be set to non-nil for automatical adding of those  
 ; word-lists.  INDENT2 specifies how to indent words that are not located at the
 ;     beginning of a line.
 ; How to use block files with conversion? Use an additional mode? File-ending  
 ; cannot be used for specifying encoding.  INDENT1 and INDENT2 are indentation specifications of the form
 ; -- Introduce a second mode `forth-blocked-mode', that decodes the buffer     (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, 
 ; `decode-coding-region' ands set `buffer-coding-system'. *Warning* block     specifying how the matching line and all following lines are to be 
 ; conversion might not work well with regions, since it's a linewise      indented, relative to previous lines. NEXT-INDENT specifies how to indent 
 ; conversion     following lines, relative to the matching line.
 ;    
 ; Konfiguration über customization groups     Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of
 ;     `forth-indent-level'. Odd values get an additional 
 ; Bereich nur auf Wortanfang/ende ausweiten, wenn anfang bzw ende in einem      `forth-minor-indent-level' added/substracted. Eg a value of -2 indents
 ; Wort liegen (?) -- speed!     1 * forth-indent-level  to the left, wheras 3 indents 
 ;     1 * forth-indent-level + forth-minor-indent-level  columns to the right.")
 ; User interface  
 ;  (setq forth-indent-words
 ; 'forth-word' property muss eindeutig sein!        '((("if" "begin" "do" "?do" "+do" "-do" "u+do"
             "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" 
             "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]")
            (0 . 2) (0 . 2))
           ((":" ":noname" "code" "struct" "m:" ":m" "class" "interface")
            (0 . 2) (0 . 2) non-immediate)
           ("\\S-+%$" (0 . 2) (0 . 0) non-immediate)
           ((";" ";m") (-2 . 0) (0 . -2))
           (("again" "then" "endif" "endtry" "endcase" "endof" 
             "[then]" "[endif]" "[loop]" "[+loop]" "[next]" 
             "[until]" "[again]" "loop")
            (-2 . 0) (0 . -2))
           (("end-code" "end-class" "end-interface" "end-class-noname" 
             "end-interface-noname" "end-struct" "class;")
            (-2 . 0) (0 . -2) non-immediate)
           (("protected" "public" "how:") (-1 . 1) (0 . 0) non-immediate)
           (("+loop" "-loop" "until") (-2 . 0) (-2 . 0))
           (("else" "recover" "[else]") (-2 . 2) (0 . 0))
           (("does>") (-1 . 1) (0 . 0))
           (("while" "[while]") (-2 . 4) (0 . 2))
           (("repeat" "[repeat]") (-4 . 0) (0 . -4))
           (("\\g") (-2 . 2) (0 . 0))))
   
 (setq debug-on-error t)  (defvar forth-local-indent-words nil 
     "List of Forth words to prepend to `forth-indent-words', when a forth-mode
   buffer is created. Should be set by a Forth source, using a local variables 
   list at the end of the file (\"Local Variables: ... forth-local-words: ... 
   End:\" construct).")
   
   (defvar forth-custom-indent-words nil
     "List of Forth words to prepend to `forth-indent-words'. Should be set in
    your .emacs.")
   
 ;; Filter list by predicat. This is a somewhat standard function for   (defvar forth-indent-level 4
     "*Indentation of Forth statements.")
   (defvar forth-minor-indent-level 2
     "*Minor indentation of Forth statements.")
   (defvar forth-compiled-indent-words nil)
   
   ;(setq debug-on-error t)
   
   ;; Filter list by predicate. This is a somewhat standard function for 
 ;; functional programming languages. So why isn't it already implemented   ;; functional programming languages. So why isn't it already implemented 
 ;; in Lisp??  ;; in Lisp??
 (defun forth-filter (predicat list)  (defun forth-filter (predicate list)
   (let ((filtered nil))    (let ((filtered nil))
     (mapcar (lambda (item)      (mapcar (lambda (item)
               (when (funcall predicat item)                (when (funcall predicate item)
                 (if filtered                  (if filtered
                     (nconc filtered (list item))                      (nconc filtered (list item))
                   (setq filtered (cons item nil))))                    (setq filtered (cons item nil))))
Line 283  PARSED-TYPE specifies what kind of text Line 475  PARSED-TYPE specifies what kind of text
 ;; Helper function for `forth-compile-word': translate one entry from   ;; Helper function for `forth-compile-word': translate one entry from 
 ;; `forth-words' into the form  (regexp regexp-depth word-description)  ;; `forth-words' into the form  (regexp regexp-depth word-description)
 (defun forth-compile-words-mapper (word)  (defun forth-compile-words-mapper (word)
     ;; warning: we cannot rely on regexp-opt's PAREN argument, since
     ;; XEmacs will use shy parens by default :-(
   (let* ((matcher (car word))    (let* ((matcher (car word))
          (regexp (if (stringp matcher) (concat "\\(" matcher "\\)")           (regexp 
                    (if (listp matcher) (regexp-opt matcher t)            (concat "\\(" (cond ((stringp matcher) matcher)
                      (error "Invalid matcher (stringp or listp expected `%s'"                                 ((listp matcher) (regexp-opt matcher))
                             matcher))))                                (t (error "Invalid matcher `%s'")))
                     "\\)"))
          (depth (regexp-opt-depth regexp))           (depth (regexp-opt-depth regexp))
          (description (cdr word)))           (description (cdr word)))
     (list regexp depth description)))      (list regexp depth description)))
Line 296  PARSED-TYPE specifies what kind of text Line 491  PARSED-TYPE specifies what kind of text
 ;; parsing of the form    ;; parsing of the form  
 ;; (regexp (subexp-count word-description) (subexp-count2 word-description2)  ;; (regexp (subexp-count word-description) (subexp-count2 word-description2)
 ;;  ...)  ;;  ...)
 (defun forth-compile-words (words)  (defun forth-compile-wordlist (words)
   (let* ((mapped (mapcar 'forth-compile-words-mapper words))    (let* ((mapped (mapcar 'forth-compile-words-mapper words))
          (regexp (concat "\\<\\("            (regexp (concat "\\<\\(" 
                          (mapconcat 'car mapped "\\|")                           (mapconcat 'car mapped "\\|")
Line 313  PARSED-TYPE specifies what kind of text Line 508  PARSED-TYPE specifies what kind of text
       (byte-compile 'result)        (byte-compile 'result)
       result)))        result)))
   
   (defun forth-compile-words ()
     "Compile the the words from `forth-words' and `forth-indent-words' into
    the format that's later used for doing the actual hilighting/indentation.
    Store the resulting compiled wordlists in `forth-compiled-words' and 
   `forth-compiled-indent-words', respective"
     (setq forth-compiled-words 
           (forth-compile-wordlist 
            (forth-filter 'forth-words-filter forth-words)))
     (setq forth-compiled-indent-words 
           (forth-compile-wordlist forth-indent-words)))
   
   (defun forth-hack-local-variables ()
     "Parse and bind local variables, set in the contents of the current 
    forth-mode buffer. Prepend `forth-local-words' to `forth-words' and 
    `forth-local-indent-words' to `forth-indent-words'."
     (hack-local-variables)
     (setq forth-words (append forth-local-words forth-words))
     (setq forth-indent-words (append forth-local-indent-words 
                                      forth-indent-words)))
   
   (defun forth-customize-words ()
     "Add the words from `forth-custom-words' and `forth-custom-indent-words'
    to `forth-words' and `forth-indent-words', respective. Add 
    `forth-objects-words' and/or `forth-oof-words' to `forth-words', if
    `forth-use-objects' and/or `forth-use-oof', respective is set."
     (setq forth-words (append forth-custom-words forth-words
                               (if forth-use-oof forth-oof-words nil)
                               (if forth-use-objects forth-objects-words nil)))
     (setq forth-indent-words (append 
                               forth-custom-indent-words forth-indent-words)))
   
   
   
 ;; get location of first character of previous forth word that's got   ;; get location of first character of previous forth word that's got 
 ;; properties  ;; properties
 (defun forth-previous-start (pos)  (defun forth-previous-start (pos)
Line 353  PARSED-TYPE specifies what kind of text Line 581  PARSED-TYPE specifies what kind of text
 ;; Delete all properties, used by Forth mode, from `from' to `to'.  ;; Delete all properties, used by Forth mode, from `from' to `to'.
 (defun forth-delete-properties (from to)  (defun forth-delete-properties (from to)
   (remove-text-properties     (remove-text-properties 
    from to '(face nil forth-parsed nil forth-word nil forth-state nil)))     from to '(face nil fontified nil 
                     forth-parsed nil forth-word nil forth-state nil)))
   
 ;; Get the index of the branch of the most recently evaluated regular   ;; Get the index of the branch of the most recently evaluated regular 
 ;; expression that matched. (used for identifying branches "a\\|b\\|c...")  ;; expression that matched. (used for identifying branches "a\\|b\\|c...")
 (defun forth-get-regexp-branch ()  (defun forth-get-regexp-branch ()
   (let ((count 2))    (let ((count 2))
     (while (not (match-beginning count))      (while (not (condition-case err (match-beginning count)
                     (args-out-of-range t)))  ; XEmacs requires error handling
       (setq count (1+ count)))        (setq count (1+ count)))
     count))      count))
   
Line 421  PARSED-TYPE specifies what kind of text Line 651  PARSED-TYPE specifies what kind of text
 ;; Search for known Forth words in the range `from' to `to', using   ;; Search for known Forth words in the range `from' to `to', using 
 ;; `forth-next-known-forth-word' and set their properties via   ;; `forth-next-known-forth-word' and set their properties via 
 ;; `forth-set-word-properties'.  ;; `forth-set-word-properties'.
 (defun forth-update-properties (from to)  (defun forth-update-properties (from to &optional loudly)
   (save-excursion    (save-excursion
     (let ((msg-flag nil) (state) (word-descr) (last-location))      (let ((msg-count 0) (state) (word-descr) (last-location))
       (when (> to (+ from 5000))  
         (setq msg-flag t) (message "Parsing Forth code..."))  
       (goto-char (forth-previous-word (forth-previous-start         (goto-char (forth-previous-word (forth-previous-start 
                                        (max (point-min) (1- from)))))                                         (max (point-min) (1- from)))))
       (setq to (forth-next-end (min (point-max) (1+ to))))        (setq to (forth-next-end (min (point-max) (1+ to))))
Line 434  PARSED-TYPE specifies what kind of text Line 662  PARSED-TYPE specifies what kind of text
       (setq state (get-text-property (point) 'forth-state))        (setq state (get-text-property (point) 'forth-state))
       (setq last-location (point))        (setq last-location (point))
       (forth-delete-properties (point) to)        (forth-delete-properties (point) to)
         (put-text-property (point) to 'fontified t)
       ;; hilight loop...        ;; hilight loop...
       (while (setq word-descr (forth-next-known-forth-word to))        (while (setq word-descr (forth-next-known-forth-word to))
           (when loudly
             (when (equal 0 (% msg-count 100))
               (message "Parsing Forth code...%s"
                        (make-string (/ msg-count 100) ?.)))
             (setq msg-count (1+ msg-count)))
         (forth-set-word-properties state word-descr)          (forth-set-word-properties state word-descr)
         (when state (put-text-property last-location (point) 'forth-state t))          (when state (put-text-property last-location (point) 'forth-state t))
         (let ((type (car word-descr)))          (let ((type (car word-descr)))
Line 452  PARSED-TYPE specifies what kind of text Line 686  PARSED-TYPE specifies what kind of text
                                 to 'forth-state (current-buffer) (point-max))))                                  to 'forth-state (current-buffer) (point-max))))
                 (forth-update-properties to extend-to))                  (forth-update-properties to extend-to))
             ))              ))
       (when msg-flag (message "Parsing Forth code...done"))  
       )))        )))
   
 ;; save-buffer-state borrowed from `font-lock.el'  ;; save-buffer-state borrowed from `font-lock.el'
Line 471  PARSED-TYPE specifies what kind of text Line 704  PARSED-TYPE specifies what kind of text
 ;; Function that is added to the `change-functions' hook. Calls   ;; Function that is added to the `change-functions' hook. Calls 
 ;; `forth-update-properties' and keeps care of disabling undo information  ;; `forth-update-properties' and keeps care of disabling undo information
 ;; and stuff like that.  ;; and stuff like that.
 (defun forth-change-function (from to len)  (defun forth-change-function (from to len &optional loudly)
   (save-match-data    (save-match-data
     (forth-save-buffer-state ()       (forth-save-buffer-state 
      (unwind-protect        () 
          (progn        (unless forth-disable-parser (forth-update-properties from to loudly))
            (forth-update-properties from to)       (forth-update-warn-long-lines))))
            (forth-update-show-screen)  
            (forth-update-warn-long-lines))))))  (defun forth-fontification-function (from)
     "Function to be called from `fontification-functions' of Emacs 21."
     (save-match-data
       (forth-save-buffer-state
        ((to (min (point-max) (+ from 100))))
        (unless (or forth-disable-parser (not forth-jit-parser)
                    (get-text-property from 'fontified))
          (forth-update-properties from to)))))
   
 (eval-when-compile  (eval-when-compile
   (byte-compile 'forth-set-word-properties)    (byte-compile 'forth-set-word-properties)
Line 487  PARSED-TYPE specifies what kind of text Line 727  PARSED-TYPE specifies what kind of text
   (byte-compile 'forth-delete-properties)    (byte-compile 'forth-delete-properties)
   (byte-compile 'forth-get-regexp-branch))     (byte-compile 'forth-get-regexp-branch)) 
   
   ;;; imenu support
   ;;;
   (defvar forth-defining-words 
     '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT"
      "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"
      "DEFER" "ALIAS")
     "List of words, that define the following word.
   Used for imenu index generation.")
   
   (defvar forth-defining-words-regexp nil 
     "Regexp that's generated for matching `forth-defining-words'")
    
   (defun forth-next-definition-starter ()
     (progn
       (let* ((pos (re-search-forward forth-defining-words-regexp (point-max) t)))
         (if pos
             (if (or (text-property-not-all (match-beginning 0) (match-end 0) 
                                            'forth-parsed nil)
                     (text-property-not-all (match-beginning 0) (match-end 0)
                                            'forth-state nil)) 
                 (forth-next-definition-starter)
               t)
           nil))))
   
   (defun forth-create-index ()
     (let* ((forth-defining-words-regexp 
             (concat "\\<\\(" (regexp-opt forth-defining-words) "\\)\\>"))
            (index nil))
       (goto-char (point-min))
       (while (forth-next-definition-starter)
         (if (looking-at "[ \t]*\\([^ \t\n]+\\)")
             (setq index (cons (cons (match-string 1) (point)) index))))
       index))
   
   ;; top-level require is executed at byte-compile and load time
   (eval-and-compile (forth-require 'speedbar))
   
   ;; this code is executed at load-time only
   (when (memq 'speedbar features)
     (speedbar-add-supported-extension ".fs")
     (speedbar-add-supported-extension ".fb"))
   
 ;; (require 'profile)  ;; (require 'profile)
 ;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch))  ;; (setq profile-functions-list '(forth-set-word-properties forth-next-known-forth-word forth-update-properties forth-delete-properties forth-get-regexp-branch))
   
 ;;; Indentation  ;;; Indentation
 ;;;  ;;;
   
 (defvar forth-indent-words nil   
   "List of words that have indentation behaviour.  
 Each element of `forth-indent-words' should have the form  
    (MATCHER INDENT1 INDENT2)   
     
 MATCHER is either a list of strings to match, or a REGEXP.  
    If it's a REGEXP, it should not be surrounded by `\\<` or `\\>`, since   
    that'll be done automatically by the search routines.  
   
 INDENT1 specifies how to indent a word that's located at a line's begin,  
    following any number of whitespaces.  
   
 INDENT2 specifies how to indent words that are not located at a line's begin.  
   
 INDENT1 and INDENT2 are indentation specifications of the form  
    (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value,   
    specifying how the matching line and all following lines are to be   
    indented, relative to previous lines. NEXT-INDENT specifies how to indent   
    following lines, relative to the matching line.  
     
    Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of  
    `forth-indent-level'. Odd values get an additional   
    `forth-minor-indent-level' added/substracted. Eg a value of -2 indents  
    1 * forth-indent-level  to the left, wheras 3 indents   
    1 * forth-indent-level + forth-minor-indent-level  columns to the right.")  
   
 (setq forth-indent-words  
       '(((":" ":noname" "code" "if" "begin" "do" "?do" "+do" "-do" "u+do"  
           "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" "struct"   
           "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]"  
           "class" "interface" "m:" ":m")  
          (0 . 2) (0 . 2))  
         ((";" ";m") (0 . -2) (0 . -2))  
         (("end-code" "again" "repeat" "then" "endtry" "endcase" "endof"   
           "end-struct" "[then]" "[endif]" "[loop]" "[+loop]" "[next]"   
           "[until]" "[repeat]" "[again]" "end-class" "end-interface"  
           "end-class-noname" "end-interface-noname" "loop"  
           "class;")  
          (-2 . 0) (0 . -2))  
         (("protected" "public" "how:") (-1 . 1) (0 . 0))  
         (("+loop" "-loop" "until") (-2 . 0) (-2 . 0))  
         (("else" "recover" "[else]") (-2 . 2) (0 . 0))  
         (("while" "does>" "[while]") (-1 . 1) (0 . 0))  
         (("\\g") (-2 . 2) (0 . 0))))  
   
 (defvar forth-indent-level 4  
   "Indentation of Forth statements.")  
 (defvar forth-minor-indent-level 2  
   "Minor indentation of Forth statements.")  
 (defvar forth-compiled-indent-words nil)  
   
 ;; Return, whether `pos' is the first forth word on its line  ;; Return, whether `pos' is the first forth word on its line
 (defun forth-first-word-on-line-p (pos)  (defun forth-first-word-on-line-p (pos)
   (save-excursion    (save-excursion
Line 561  INDENT1 and INDENT2 are indentation spec Line 792  INDENT1 and INDENT2 are indentation spec
         (let* ((regexp (car forth-compiled-indent-words))          (let* ((regexp (car forth-compiled-indent-words))
                (pos (re-search-forward regexp to t)))                 (pos (re-search-forward regexp to t)))
           (if pos            (if pos
               (if (text-property-not-all (match-beginning 0) (match-end 0)                 (let* ((start (match-beginning 0))
                                          'forth-parsed nil)                       (end (match-end 0))
                   (forth-next-known-indent-word to)                       (branch (forth-get-regexp-branch))
                 (let* ((branch (forth-get-regexp-branch))                       (descr (cdr forth-compiled-indent-words))
                        (descr (cdr forth-compiled-indent-words))                       (indent (cdr (assoc branch descr)))
                        (indent (cdr (assoc branch descr))))                       (type (nth 2 indent)))
                   ;; skip words that are parsed (strings/comments) and 
                   ;; non-immediate words inside definitions
                   (if (or (text-property-not-all start end 'forth-parsed nil)
                           (and (eq type 'non-immediate) 
                                (text-property-not-all start end 
                                                       'forth-state nil)))
                       (forth-next-known-indent-word to)
                   (if (forth-first-word-on-line-p (match-beginning 0))                    (if (forth-first-word-on-line-p (match-beginning 0))
                       (nth 0 indent) (nth 1 indent))))                        (nth 0 indent) (nth 1 indent))))
             nil)))              nil)))
Line 614  INDENT1 and INDENT2 are indentation spec Line 852  INDENT1 and INDENT2 are indentation spec
 (defun forth-get-anchor-column ()  (defun forth-get-anchor-column ()
   (save-excursion    (save-excursion
     (if (/= 0 (forward-line -1)) 0      (if (/= 0 (forward-line -1)) 0
       (let ((next-indent)        (let ((indent))
             (self-indent))  
         (while (not (or (setq indent (forth-get-column-incr 1))          (while (not (or (setq indent (forth-get-column-incr 1))
                         (<= (point) (point-min))))                          (<= (point) (point-min))))
           (forward-line -1))            (forward-line -1))
Line 627  INDENT1 and INDENT2 are indentation spec Line 864  INDENT1 and INDENT2 are indentation spec
          (column-incr (forth-get-column-incr 0)))           (column-incr (forth-get-column-incr 0)))
     (forth-indent-to (if column-incr (+ anchor column-incr) anchor))))      (forth-indent-to (if column-incr (+ anchor column-incr) anchor))))
   
   (defun forth-current-column ()
     (- (point) (save-excursion (beginning-of-line) (point))))
   (defun forth-current-indentation ()
     (- (save-excursion (beginning-of-line) (forward-to-indentation 0) (point))
        (save-excursion (beginning-of-line) (point))))
   
 (defun forth-indent-to (x)  (defun forth-indent-to (x)
   (let ((p nil))    (let ((p nil))
     (setq p (- (current-column) (current-indentation)))      (setq p (- (forth-current-column) (forth-current-indentation)))
     (forth-delete-indentation)      (forth-delete-indentation)
     (beginning-of-line)      (beginning-of-line)
     (indent-to x)      (indent-to x)
Line 653  INDENT1 and INDENT2 are indentation spec Line 896  INDENT1 and INDENT2 are indentation spec
   
 ;; insert newline, removing any trailing whitespaces in the current line  ;; insert newline, removing any trailing whitespaces in the current line
 (defun forth-newline-remove-trailing ()  (defun forth-newline-remove-trailing ()
   (newline)  
   (save-excursion    (save-excursion
     (forward-line -1)      (delete-region (point) (progn (skip-chars-backward " \t") (point))))
     (forth-remove-trailing)))    (newline))
   ;  (let ((was-point (point-marker)))
   ;    (unwind-protect 
   ;       (progn (forward-line -1) (forth-remove-trailing))
   ;      (goto-char (was-point)))))
   
 ;; workaround for bug in `reindent-then-newline-and-indent'  ;; workaround for bug in `reindent-then-newline-and-indent'
 (defun forth-reindent-then-newline-and-indent ()  (defun forth-reindent-then-newline-and-indent ()
Line 665  INDENT1 and INDENT2 are indentation spec Line 911  INDENT1 and INDENT2 are indentation spec
   (forth-newline-remove-trailing)    (forth-newline-remove-trailing)
   (indent-according-to-mode))    (indent-according-to-mode))
   
 ;;; end hilighting/indentation  
   
 ;;; Block file encoding/decoding  (dk)  ;;; Block file encoding/decoding  (dk)
 ;;;  ;;;
Line 769  done by checking whether the first line Line 1014  done by checking whether the first line
   (save-restriction     (save-restriction 
     (widen)      (widen)
     (save-excursion      (save-excursion
        (beginning-of-buffer)         (goto-char (point-min))
        (end-of-line)         (end-of-line)
        (>= (current-column) 1024))))         (>= (current-column) 1024))))
   
Line 793  done by checking whether the first line Line 1038  done by checking whether the first line
   "Non-nil means to warn about lines that are longer than 64 characters")    "Non-nil means to warn about lines that are longer than 64 characters")
   
 (defvar forth-screen-marker nil)  (defvar forth-screen-marker nil)
   (defvar forth-screen-number-string nil)
   
 (defun forth-update-show-screen ()  (defun forth-update-show-screen ()
   "If `forth-show-screen' is non-nil, put overlay arrow to start of screen,     "If `forth-show-screen' is non-nil, put overlay arrow to start of screen, 
Line 807  screen number." Line 1053  screen number."
         (setq overlay-arrow-string forth-overlay-arrow-string)          (setq overlay-arrow-string forth-overlay-arrow-string)
         (goto-line first-line)          (goto-line first-line)
         (setq overlay-arrow-position forth-screen-marker)          (setq overlay-arrow-position forth-screen-marker)
         (when (/= forth-screen-marker (point))          (set-marker forth-screen-marker 
           (message "Entered screen #%i" scr)                      (save-excursion (goto-line first-line) (point)))
           (set-marker forth-screen-marker (point)))))))          (setq forth-screen-number-string (format "%d" scr))))))
   
 (add-hook 'forth-motion-hooks 'forth-update-show-screen)  (add-hook 'forth-motion-hooks 'forth-update-show-screen)
   
Line 822  exceeds 64 characters." Line 1068  exceeds 64 characters."
                forth-c/l))))                 forth-c/l))))
   
 (add-hook 'forth-motion-hooks 'forth-update-warn-long-lines)  (add-hook 'forth-motion-hooks 'forth-update-warn-long-lines)
       
 ;;; End block file editing  ;;; End block file editing
   
   
Line 849  exceeds 64 characters." Line 1095  exceeds 64 characters."
 (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)
   
 ;;; hook into motion events (realy ugly!)  (dk)  ;; setup for C-h C-i to work
 (define-key forth-mode-map "\C-n" 'forth-next-line)  (eval-and-compile (forth-require 'info-look))
 (define-key forth-mode-map "\C-p" 'forth-previous-line)  (when (memq 'info-look features)
 (define-key forth-mode-map [down] 'forth-next-line)    (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t 
 (define-key forth-mode-map [up] 'forth-previous-line)                                                    (("(gforth)Word Index"))
 (define-key forth-mode-map "\C-f" 'forth-forward-char)                                                    "\\S-+")))
 (define-key forth-mode-map "\C-b" 'forth-backward-char)    (unless (memq forth-info-lookup info-lookup-alist)
 (define-key forth-mode-map [right] 'forth-forward-char)      (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist)))
 (define-key forth-mode-map [left] 'forth-backward-char)    ;; in X-Emacs C-h C-i is by default bound to Info-query
 (define-key forth-mode-map "\M-f" 'forth-forward-word)    (define-key forth-mode-map "\C-h\C-i" 'info-lookup-symbol))
 (define-key forth-mode-map "\M-b" 'forth-backward-word)  
 (define-key forth-mode-map [C-right] 'forth-forward-word)  
 (define-key forth-mode-map [C-left] 'forth-backward-word)  ;;   (info-lookup-add-help
 (define-key forth-mode-map "\M-v" 'forth-scroll-down)  ;;    :topic 'symbol
 (define-key forth-mode-map "\C-v" 'forth-scroll-up)  ;;    :mode 'forth-mode
 (define-key forth-mode-map [prior] 'forth-scroll-down)  ;;    :regexp "[^       
 (define-key forth-mode-map [next] 'forth-scroll-up)  ;; ]+"
   ;;    :ignore-case t
 (defun forth-next-line (arg)   ;;    :doc-spec '(("(gforth)Name Index" nil "`" "'  "))))
   (interactive "p") (next-line arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-previous-line (arg)  
   (interactive "p") (previous-line arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-backward-char (arg)  
   (interactive "p") (backward-char arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-forward-char (arg)  
   (interactive "p") (forward-char arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-forward-word (arg)  
   (interactive "p") (forward-word arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-backward-word (arg)  
   (interactive "p") (backward-word arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-scroll-down (arg)  
   (interactive "P") (scroll-down arg) (run-hooks 'forth-motion-hooks))  
 (defun forth-scroll-up (arg)  
   (interactive "P") (scroll-up arg) (run-hooks 'forth-motion-hooks))  
   
 ;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")  (require '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: "))
     (unless (or regexp-p next-p)
       (setq tagname (concat "\\(^\\|\\s-\\)\\(" (regexp-quote tagname) 
                               "\\)\\(\\s-\\|$\\)")))
   (switch-to-buffer    (switch-to-buffer
    (find-tag-noselect (concat " " tagname " ") next-p regexp-p)))     (find-tag-noselect tagname next-p t)))
   
 (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 920  exceeds 64 characters." Line 1144  exceeds 64 characters."
           (setq char (1+ char))))            (setq char (1+ char))))
       ))        ))
   
   
 (defun forth-mode-variables ()  (defun forth-mode-variables ()
   (set-syntax-table forth-mode-syntax-table)    (set-syntax-table forth-mode-syntax-table)
   (setq local-abbrev-table forth-mode-abbrev-table)    (setq local-abbrev-table forth-mode-abbrev-table)
Line 939  exceeds 64 characters." Line 1162  exceeds 64 characters."
   (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-function)
   (setq comment-indent-hook 'forth-comment-indent)    (setq comment-indent-function '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)
   
   (setq case-fold-search t)    (setq case-fold-search t)
     (make-local-variable 'forth-was-point)
     (setq forth-was-point -1)
   (make-local-variable 'forth-words)    (make-local-variable 'forth-words)
   (make-local-variable 'forth-compiled-words)    (make-local-variable 'forth-compiled-words)
   (make-local-variable 'forth-compiled-indent-words)    (make-local-variable 'forth-compiled-indent-words)
Line 954  exceeds 64 characters." Line 1178  exceeds 64 characters."
   (make-local-variable 'forth-show-screen)    (make-local-variable 'forth-show-screen)
   (make-local-variable 'forth-screen-marker)    (make-local-variable 'forth-screen-marker)
   (make-local-variable 'forth-warn-long-lines)    (make-local-variable 'forth-warn-long-lines)
     (make-local-variable 'forth-screen-number-string)
     (make-local-variable 'forth-use-oof)
     (make-local-variable 'forth-use-objects) 
   (setq forth-screen-marker (copy-marker 0))    (setq forth-screen-marker (copy-marker 0))
 )    (add-hook 'after-change-functions 'forth-change-function)
     (if (and forth-jit-parser (>= emacs-major-version 21))
         (add-hook 'fontification-functions 'forth-fontification-function))
     (setq imenu-create-index-function 'forth-create-index))
   
 (defun forth-mode-hook-dependent-variables ()  
   (setq forth-compiled-words   
         (forth-compile-words (forth-filter 'forth-words-filter forth-words)))  
   (setq forth-compiled-indent-words   
         (forth-compile-words forth-indent-words)))  
     
 ;;;###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. Block files are autodetected, when read, and converted to normal stream  only. Block files are autodetected, when read, and converted to normal 
 source format. See also `forth-block-mode'.  stream source format. See also `forth-block-mode'.
 \\{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 1000  Variables controlling interaction and st Line 1224  Variables controlling interaction and st
 Variables controlling syntax hilighting/recognition of parsed text:  Variables controlling syntax hilighting/recognition of parsed text:
  `forth-words'   `forth-words'
     List of words that have a special parsing behaviour and/or should be      List of words that have a special parsing behaviour and/or should be
     hilighted.      hilighted. Add custom words by setting forth-custom-words in your
  forth-objects-words      .emacs, or by setting forth-local-words, in source-files' local 
     Hilighting information for the words of the \"Objects\" package for       variables lists.
     object-oriented programming. Append it to `forth-words', if required.   forth-use-objects
  forth-oof-words      Set this variable to non-nil in your .emacs, or in a local variables 
     Hilighting information for the words of the \"OOF\" package.      list, to hilight and recognize the words from the \"Objects\" package 
       for object-oriented programming.
    forth-use-oof
       Same as above, just for the \"OOF\" package.
    forth-custom-words
       List of custom Forth words to prepend to `forth-words'. Should be set
       in your .emacs.
    forth-local-words
       List of words to prepend to `forth-words', whenever a forth-mode
       buffer is created. That variable should be set by Forth sources, using
       a local variables list at the end of file, to get file-specific
       hilighting.
       0 [IF]
          Local Variables: ... 
          forth-local-words: ...
          End:
       [THEN]
  forth-hilight-level   forth-hilight-level
     Controls how much syntax hilighting is done. Should be in the range       Controls how much syntax hilighting is done. Should be in the range 
     0 (no hilighting) up to 3.      0..3
   
 Variables controlling indentation style:  Variables controlling indentation style:
  `forth-indent-words'   `forth-indent-words'
     List of words that influence indentation.      List of words that influence indentation.
    forth-local-indent-words
       List of words to prepend to `forth-indent-words', similar to 
       forth-local-words. Should be used for specifying file-specific 
       indentation, using a local variables list.
    forth-custom-indent-words
       List of words to prepend to `forth-indent-words'. Should be set in your
       .emacs.    
  forth-indent-level   forth-indent-level
     Indentation increment/decrement of Forth statements.      Indentation increment/decrement of Forth statements.
  forth-minor-indent-level   forth-minor-indent-level
     Minor indentation increment/decrement of Forth statemens.      Minor indentation increment/decrement of Forth statemens.
   
 Variables controlling block-file editing:  Variables controlling block-file editing:
  `forth-show-screen'   forth-show-screen
     Non-nil means, that the start of the current screen is marked by an      Non-nil means, that the start of the current screen is marked by an
     overlay arrow, and motion over screen boundaries displays the number       overlay arrow, and screen numbers are displayed in the mode line.
     of the screen entered. This variable is by default nil for `forth-mode'       This variable is by default nil for `forth-mode' and t for 
     and t for `forth-block-mode'.      `forth-block-mode'.
  `forth-overlay-arrow-string'   forth-overlay-arrow-string
     String to display as the overlay arrow, when `forth-show-screen' is t.      String to display as the overlay arrow, when `forth-show-screen' is t.
     Setting this variable to nil disables the overlay arrow.      Setting this variable to nil disables the overlay arrow.
  `forth-block-base'   forth-block-base
     Screen number of the first block in a block file. Defaults to 1.      Screen number of the first block in a block file. Defaults to 1.
  `forth-warn-long-lines'   forth-warn-long-lines
     Non-nil means that a warning message is displayed whenever you edit or      Non-nil means that a warning message is displayed whenever you edit or
     move over a line that is longer than 64 characters (the maximum line      move over a line that is longer than 64 characters (the maximum line
     length that can be stored into a block file). This variable defaults to      length that can be stored into a block file). This variable defaults to
Line 1051  Variables controling documentation searc Line 1298  Variables controling documentation searc
   (use-local-map forth-mode-map)    (use-local-map forth-mode-map)
   (setq mode-name "Forth")    (setq mode-name "Forth")
   (setq major-mode 'forth-mode)    (setq major-mode 'forth-mode)
     (forth-install-motion-hook)
   ;; convert buffer contents from block file format, if necessary    ;; convert buffer contents from block file format, if necessary
   (when (forth-detect-block-file-p)    (when (forth-detect-block-file-p)
     (widen)      (widen)
Line 1064  Variables controling documentation searc Line 1312  Variables controling documentation searc
   (forth-mode-variables)    (forth-mode-variables)
 ;  (if (not (forth-process-running-p))  ;  (if (not (forth-process-running-p))
 ;      (run-forth forth-program-name))  ;      (run-forth forth-program-name))
   (run-hooks 'forth-mode-hook)    (run-hooks 'forth-mode-hook))
   (forth-mode-hook-dependent-variables)  
   (forth-change-function (point-min) (point-max) nil)  
   (add-hook 'after-change-functions 'forth-change-function))  
   
   ;;;###autoload
 (define-derived-mode forth-block-mode forth-mode "Forth Block Source"   (define-derived-mode forth-block-mode forth-mode "Forth Block Source" 
   "Major mode for editing Forth block source files, derived from     "Major mode for editing Forth block source files, derived from 
 `forth-mode'. Differences to `forth-mode' are:  `forth-mode'. Differences to `forth-mode' are:
Line 1082  echo area and the line is truncated. Line 1328  echo area and the line is truncated.
   
 Another problem is imposed by block files that contain newline or tab   Another problem is imposed by block files that contain newline or tab 
 characters. When Emacs converts such files back to block file format,   characters. When Emacs converts such files back to block file format, 
 it'll translate those characters to a number of spaces. However, whenever  it'll translate those characters to a number of spaces. However, when
 you read such a file, a warning message is displayed in the echo area,  you read such a file, a warning message is displayed in the echo area,
 including a line number that may help you to locate and fix the problem.  including a line number that may help you to locate and fix the problem.
   
Line 1090  So have a look at the *Messages* buffer, Line 1336  So have a look at the *Messages* buffer,
 bell during block file read/write operations."  bell during block file read/write operations."
   (setq buffer-file-format '(forth-blocks))    (setq buffer-file-format '(forth-blocks))
   (setq forth-show-screen t)    (setq forth-show-screen t)
   (setq forth-warn-long-lines t))    (setq forth-warn-long-lines t)
     (setq forth-screen-number-string (format "%d" forth-block-base))
     (setq mode-line-format (append (reverse (cdr (reverse mode-line-format)))
                                    '("--S" forth-screen-number-string "-%-"))))
   
 (add-hook '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 ")
            (forth-hack-local-variables)
            (forth-customize-words)
            (forth-compile-words)
            (unless (and forth-jit-parser (>= emacs-major-version 21))
              (forth-change-function (point-min) (point-max) nil t))))
   
 (defun forth-fill-paragraph ()   (defun forth-fill-paragraph () 
   "Fill comments (starting with '\'; do not fill code (block style    "Fill comments (starting with '\'; do not fill code (block style
Line 1620  The region is sent terminated by a newli Line 1874  The region is sent terminated by a newli
   
 (define-key forth-mode-map "\C-x\C-e" '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)
   
 (defvar forth-compile-command "gforth ")  (defvar forth-compile-command "gforth ")
 ;(defvar forth-compilation-window-percent-height 30)  ;(defvar forth-compilation-window-percent-height 30)
Line 1635  The region is sent terminated by a newli Line 1889  The region is sent terminated by a newli
 ;;; Forth menu  ;;; Forth menu
 ;;; Mikael Karlsson <qramika@eras70.ericsson.se>  ;;; Mikael Karlsson <qramika@eras70.ericsson.se>
   
 (cond ((string-match "XEmacs\\|Lucid" emacs-version)  ;; (dk) code commented out due to complaints of XEmacs users.  After
        (require 'func-menu)  ;; all, there's imenu/speedbar, which uses much smarter scanning
   ;; rules.
   (defconst fume-function-name-regexp-forth  
    "^\\(:\\)[ \t]+\\([^ \t]*\\)"  ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version)
    "Expression to get word definitions in Forth.")  ;;        (require 'func-menu)
   
   (setq fume-function-name-regexp-alist  ;;   (defconst fume-function-name-regexp-forth
       (append '((forth-mode . fume-function-name-regexp-forth)   ;;    "^\\(:\\)[ \t]+\\([^ \t]*\\)"
              ) fume-function-name-regexp-alist))  ;;    "Expression to get word definitions in Forth.")
   
   ;; Find next forth word in the buffer  ;;   (setq fume-function-name-regexp-alist
   (defun fume-find-next-forth-function-name (buffer)  ;;       (append '((forth-mode . fume-function-name-regexp-forth) 
     "Searches for the next forth word in BUFFER."  ;;              ) fume-function-name-regexp-alist))
     (set-buffer buffer)  
     (if (re-search-forward fume-function-name-regexp nil t)  ;;   ;; Find next forth word in the buffer
       (let ((beg (match-beginning 2))  ;;   (defun fume-find-next-forth-function-name (buffer)
             (end (match-end 2)))  ;;     "Searches for the next forth word in BUFFER."
         (cons (buffer-substring beg end) beg))))  ;;     (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  ;;   (setq fume-find-function-name-method-alist
   (append '((forth-mode    . fume-find-next-forth-function-name))))  ;;   (append '((forth-mode    . fume-find-next-forth-function-name))))
   
   ))  ;;   ))
 ;;; End Forth menu  ;;; End Forth menu
   
 ;;; File folding of forth-files  ;;; File folding of forth-files
Line 1669  The region is sent terminated by a newli Line 1927  The region is sent terminated by a newli
 ;;; Works most of the times but loses sync with the cursor occasionally   ;;; Works most of the times but loses sync with the cursor occasionally 
 ;;; Could be improved by also folding on comments  ;;; Could be improved by also folding on comments
   
 (require 'outline)  ;; (dk) This code needs a rewrite; just too ugly and doesn't use the
   ;; newer and smarter scanning rules of `imenu'. Who needs it anyway??
   
 (defun f-outline-level ()  ;; (require 'outline)
         (cond   ((looking-at "\\`\\\\")  
                         0)  ;; (defun f-outline-level ()
                 ((looking-at "\\\\ SEC")  ;;   (cond      ((looking-at "\\`\\\\")
                         0)  ;;       0)
                 ((looking-at "\\\\ \\\\ .*")  ;;      ((looking-at "\\\\ SEC")
                         0)  ;;       0)
                 ((looking-at "\\\\ DEFS")  ;;      ((looking-at "\\\\ \\\\ .*")
                         1)  ;;       0)
                 ((looking-at "\\/\\* ")  ;;      ((looking-at "\\\\ DEFS")
                         1)  ;;       1)
                 ((looking-at ": .*")  ;;      ((looking-at "\\/\\* ")
                         1)  ;;       1)
                 ((looking-at "\\\\G")  ;;      ((looking-at ": .*")
                         2)  ;;       1)
                 ((looking-at "[ \t]+\\\\")  ;;      ((looking-at "\\\\G")
                         3))  ;;       2)
 )                         ;;      ((looking-at "[ \t]+\\\\")
   ;;       3)))
 (defun fold-f  ()    
    (interactive)  ;; (defun fold-f  ()
    (add-hook 'outline-minor-mode-hook 'hide-body)  ;;    (interactive)
   ;;    (add-hook 'outline-minor-mode-hook 'hide-body)
    ; outline mode header start, i.e. find word definitions  
 ;;;   (setq  outline-regexp  "^\\(:\\)[ \t]+\\([^ \t]*\\)")  ;;    ; outline mode header start, i.e. find word definitions
    (setq  outline-regexp  "\\`\\\\\\|:\\|\\\\ SEC\\|\\\\G\\|[ \t]+\\\\\\|\\\\ DEFS\\|\\/\\*\\|\\\\ \\\\ .*")  ;; ;;;   (setq  outline-regexp  "^\\(:\\)[ \t]+\\([^ \t]*\\)")
    (setq outline-level 'f-outline-level)  ;;    (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)  ;;    (outline-minor-mode)
    (define-key outline-minor-mode-map '(shift right) 'show-children)  ;;    (define-key outline-minor-mode-map '(shift up) 'hide-sublevels)
    (define-key outline-minor-mode-map '(shift left) 'hide-subtree)  ;;    (define-key outline-minor-mode-map '(shift right) 'show-children)
    (define-key outline-minor-mode-map '(shift down) 'show-subtree)  ;;    (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)  ;;(define-key global-map '(shift up) 'fold-f)
   
Line 1717  The region is sent terminated by a newli Line 1976  The region is sent terminated by a newli
 ;;; for all of the recognized languages.  Scanning the buffer takes some time,  ;;; for all of the recognized languages.  Scanning the buffer takes some time,
 ;;; but not much.  ;;; but not much.
 ;;;  ;;;
 (cond ((string-match "XEmacs\\|Lucid" emacs-version)  ;; (cond ((string-match "XEmacs\\|Lucid" emacs-version)
        (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)
 ))  ;; ))
   
 ;;; gforth.el ends here  (provide 'forth-mode)
   
   ;;; gforth.el ends here
Removed from v.1.48  
changed lines
  Added in v.1.65

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