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

Diff for /gforth/gforth.el between versions 1.55 and 1.61

version 1.55, 2001/12/15 22:44:52 version 1.61, 2002/03/23 13:38:04
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  ;; Code ripped from `version.el' for compatability with Emacs versions
 ;; prior to 19.23.  ;; prior to 19.23.
 (unless (boundp 'emacs-major-version)  (if (not (boundp 'emacs-major-version))
   (defconst emacs-major-version      (defconst emacs-major-version
     (progn (string-match "^[0-9]+" emacs-version)        (progn (string-match "^[0-9]+" emacs-version)
            (string-to-int (match-string 0 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)))
   
   ; 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)
   
 ;;; Hilighting and indentation engine                           (dk)  ;;; Hilighting and indentation engine                           (dk)
 ;;;  ;;;
   
 (defvar forth-disable-parser nil  (defvar forth-disable-parser nil
   "*Non-nil means to disable on-the-fly parsing of Forth-code.    "*Non-nil means to disable on-the-fly parsing of Forth-code.
   
Line 155  PARSED-TYPE specifies what kind of text Line 233  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"
           "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 164  PARSED-TYPE specifies what kind of text Line 243  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))
         (("~~" "break:") compile-only (font-lock-warning-face . 2))          (("~~" "break:" "dbg") compile-only (font-lock-warning-face . 2))
         (("break\"") compile-only (font-lock-warning-face . 1)          (("break\"") compile-only (font-lock-warning-face . 1)
          "[\"\n]" nil string (font-lock-string-face . 1))           "[\"\n]" nil string (font-lock-string-face . 1))
         (("postpone" "[is]" "defers" "[']" "[compile]")           (("postpone" "[is]" "defers" "[']" "[compile]") 
Line 172  PARSED-TYPE specifies what kind of text Line 251  PARSED-TYPE specifies what kind of text
          "[ \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 199  PARSED-TYPE specifies what kind of text Line 278  PARSED-TYPE specifies what kind of text
   
 (defvar forth-use-objects nil   (defvar forth-use-objects nil 
   "*Non-nil makes forth-mode also hilight words from the \"Objects\" package.")    "*Non-nil makes forth-mode also hilight words from the \"Objects\" package.")
 (defvar forth-objects-words nil  (defvar forth-objects-words
     '(((":m") definition-starter (font-lock-keyword-face . 1)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("m:") definition-starter (font-lock-keyword-face . 1))
       ((";m") definition-ender (font-lock-keyword-face . 1))
       (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("current" "overrides") non-immediate (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("[to-inst]") compile-only (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-variable-name-face . 3))
       (("[bind]") compile-only (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-type-face . 3)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("bind") non-immediate (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-type-face . 3)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2)
        "[ \t\n]" t name (font-lock-variable-name-face . 3))
       (("method" "selector")
        non-immediate (font-lock-type-face . 1)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("end-class" "end-interface")
        non-immediate (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-type-face . 3))
       (("public" "protected" "class" "exitm" "implementation" "interface"
         "methods" "end-methods" "this") 
        non-immediate (font-lock-keyword-face . 2))
       (("object") non-immediate (font-lock-type-face . 2)))
   "Hilighting description for words of the \"Objects\" package")    "Hilighting description for words of the \"Objects\" package")
 (setq forth-objects-words   
       '(((":m") definition-starter (font-lock-keyword-face . 1)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("m:") definition-starter (font-lock-keyword-face . 1))  
         ((";m") definition-ender (font-lock-keyword-face . 1))  
         (("[current]" "[parent]") compile-only (font-lock-keyword-face . 1)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("current" "overrides") non-immediate (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("[to-inst]") compile-only (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-variable-name-face . 3))  
         (("[bind]") compile-only (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-type-face . 3)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("bind") non-immediate (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-type-face . 3)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2)  
          "[ \t\n]" t name (font-lock-variable-name-face . 3))  
         (("method" "selector")  
          non-immediate (font-lock-type-face . 1)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("end-class" "end-interface")  
          non-immediate (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-type-face . 3))  
         (("public" "protected" "class" "exitm" "implementation" "interface"  
           "methods" "end-methods" "this")   
          non-immediate (font-lock-keyword-face . 2))  
         (("object") non-immediate (font-lock-type-face . 2))))  
   
 (defvar forth-use-oof nil   (defvar forth-use-oof nil 
   "*Non-nil makes forth-mode also hilight words from the \"OOF\" package.")    "*Non-nil makes forth-mode also hilight words from the \"OOF\" package.")
 (defvar forth-oof-words nil  (defvar forth-oof-words 
     '((("class") non-immediate (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-type-face . 3))
       (("var") non-immediate (font-lock-type-face . 2)
        "[ \t\n]" t name (font-lock-variable-name-face . 3))
       (("method" "early") non-immediate (font-lock-type-face . 2)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("::" "super" "bind" "bound" "link") 
        immediate (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-function-name-face . 3))
       (("ptr" "asptr" "[]") 
        immediate (font-lock-keyword-face . 2)
        "[ \t\n]" t name (font-lock-variable-name-face . 3))
       (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with"
         "endwith")
        non-immediate (font-lock-keyword-face . 2))
       (("object") non-immediate (font-lock-type-face . 2)))
   "Hilighting description for words of the \"OOF\" package")    "Hilighting description for words of the \"OOF\" package")
 (setq forth-oof-words   
       '((("class") non-immediate (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-type-face . 3))  
         (("var") non-immediate (font-lock-type-face . 2)  
          "[ \t\n]" t name (font-lock-variable-name-face . 3))  
         (("method" "early") non-immediate (font-lock-type-face . 2)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("::" "super" "bind" "bound" "link")   
          immediate (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-function-name-face . 3))  
         (("ptr" "asptr" "[]")   
          immediate (font-lock-keyword-face . 2)  
          "[ \t\n]" t name (font-lock-variable-name-face . 3))  
         (("class;" "how:" "self" "new" "new[]" "definitions" "class?" "with"  
           "endwith")  
          non-immediate (font-lock-keyword-face . 2))  
         (("object") non-immediate (font-lock-type-face . 2))))  
   
 (defvar forth-local-words nil   (defvar forth-local-words nil 
   "List of Forth words to prepend to `forth-words'. Should be set by a     "List of Forth words to prepend to `forth-words'. Should be set by a 
Line 266  PARSED-TYPE specifies what kind of text Line 344  PARSED-TYPE specifies what kind of text
   
 (defvar forth-compiled-words nil "Compiled representation of `forth-words'.")  (defvar forth-compiled-words nil "Compiled representation of `forth-words'.")
   
   (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.
   
 ; todo:  TYPE might be omitted. If it's specified, the only allowed value is 
 ;     currently the symbol `non-immediate', meaning that the word will not 
      have any effect on indentation inside definitions. (:NONAME is a good 
      example for this kind of word).
   
 ; Wörter ordentlich hilighten, die nicht auf Whitespace beginnen ( ..)IF  INDENT1 specifies how to indent a word that's located at a line's begin,
 ; -- mit aktueller Konzeption nicht möglich??     following any number of whitespaces.
 ;  
 ; Konfiguration über customization groups  INDENT2 specifies how to indent words that are not located at a line's begin.
 ;  
 ; Bereich nur auf Wortanfang/ende ausweiten, wenn Anfang bzw Ende in einem   INDENT1 and INDENT2 are indentation specifications of the form
 ; Wort liegen (?) -- speed!     (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, 
 ;     specifying how the matching line and all following lines are to be 
 ; 'forth-word' property muss eindeutig sein!     indented, relative to previous lines. NEXT-INDENT specifies how to indent 
 ;     following lines, relative to the matching line.
 ; Forth-Menu     
 ;     Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of
 ; Interface zu GForth Prozessen (Patches von Michael Scholz)     `forth-indent-level'. Odd values get an additional 
 ;     `forth-minor-indent-level' added/substracted. Eg a value of -2 indents
 ; Byte-compile-Code rausschmeißen, Compilieren im Makefile über Emacs     1 * forth-indent-level  to the left, wheras 3 indents 
 ; batch-Modus     1 * forth-indent-level + forth-minor-indent-level  columns to the right.")
 ;  
 ; forth-help Kram rausschmeißen  (setq forth-indent-words
 ;        '((("if" "begin" "do" "?do" "+do" "-do" "u+do"
 ; XEmacs Kompatibilität? imenu/speedbar -> fume?            "u-do" "?dup-if" "?dup-0=-if" "case" "of" "try" 
 ;             "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]")
 ; Folding neuschreiben (neue Parser-Informationen benutzen)           (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" "repeat" "then" "endif" "endtry" "endcase" "endof" 
             "[then]" "[endif]" "[loop]" "[+loop]" "[next]" 
             "[until]" "[repeat]" "[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))
           (("while" "does>" "[while]") (-1 . 1) (0 . 0))
           (("\\g") (-2 . 2) (0 . 0))))
   
   (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.")
   
   (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)  ;(setq debug-on-error t)
   
Line 320  PARSED-TYPE specifies what kind of text Line 440  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 430  PARSED-TYPE specifies what kind of text Line 553  PARSED-TYPE specifies what kind of text
 ;; 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 577  PARSED-TYPE specifies what kind of text Line 701  PARSED-TYPE specifies what kind of text
   "List of words, that define the following word.    "List of words, that define the following word.
 Used for imenu index generation.")  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 ()  (defun forth-next-definition-starter ()
   (progn    (progn
Line 600  Used for imenu index generation.") Line 726  Used for imenu index generation.")
           (setq index (cons (cons (match-string 1) (point)) index))))            (setq index (cons (cons (match-string 1) (point)) index))))
     index))      index))
   
 (unwind-protect  ;; top-level require is executed at byte-compile and load time
     (progn  (eval-and-compile (forth-require 'speedbar))
       (require 'speedbar)  
       (speedbar-add-supported-extension ".fs")  ;; this code is executed at load-time only
       (speedbar-add-supported-extension ".fb")))  (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))
Line 612  Used for imenu index generation.") Line 740  Used for imenu index generation.")
 ;;; 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 &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.  
   
 TYPE might be omitted. If it's specified, the only allowed value is   
    currently the symbol `non-immediate', meaning that the word will not   
    have any effect on indentation inside definitions. (:NONAME is a good   
    example for this kind of word).  
   
 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  
       '((("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" "repeat" "then" "endtry" "endcase" "endof"   
           "[then]" "[endif]" "[loop]" "[+loop]" "[next]"   
           "[until]" "[repeat]" "[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))  
         (("while" "does>" "[while]") (-1 . 1) (0 . 0))  
         (("\\g") (-2 . 2) (0 . 0))))  
   
 (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.")  
   
 (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 945  done by checking whether the first line Line 1004  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 1008  exceeds 64 characters." Line 1068  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)
   
 ;setup for C-h C-i to work  ;; setup for C-h C-i to work
 (if (fboundp 'info-lookup-add-help)  (eval-and-compile (forth-require 'info-look))
     (info-lookup-add-help  (when (memq 'info-look features)
      :topic 'symbol    (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t 
      :mode 'forth-mode                                                    (("(gforth)Word Index"))
      :regexp "[^                                                            "\\S-+")))
 ]+"    (unless (memq forth-info-lookup info-lookup-alist)
      :ignore-case t      (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist)))
      :doc-spec '(("(gforth)Name Index" nil "`" "'  "))))    ;; in X-Emacs C-h C-i is by default bound to Info-query
     (define-key forth-mode-map "\C-h\C-i" 'info-lookup-symbol))
   
   
   ;;   (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: "))
Line 1067  exceeds 64 characters." Line 1137  exceeds 64 characters."
   (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)
Line 1779  The region is sent terminated by a newli Line 1849  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 1794  The region is sent terminated by a newli Line 1864  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 1828  The region is sent terminated by a newli Line 1902  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 1876  The region is sent terminated by a newli Line 1951  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)
 ))  ;; ))
   
   (provide 'forth-mode)
   
 ;;; gforth.el ends here  ;;; gforth.el ends here
Removed from v.1.55  
changed lines
  Added in v.1.61

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