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

Diff for /gforth/gforth.el between versions 1.54 and 1.64

version 1.54, 2001/09/03 20:21:26 version 1.64, 2002/12/21 17:27:13
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)))
   
   ; 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)  ;;; 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. After `forth-words' changed, `forth-compile-words'   `forth-objects-words' or `forth-oof-words' to the list, depending on the values of `forth-use-objects' or `forth-use-oof'.
 must be called to make the changes take effect.  
   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 132  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 141  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 174  PARSED-TYPE specifies what kind of text Line 310  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") 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 241  PARSED-TYPE specifies what kind of text Line 376  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 beginning ( ..)IF  INDENT1 specifies how to indent a word that's located at the beginning
 ; 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. Using local variable list?  INDENT2 specifies how to indent words that are not located at the
 ;     beginning of a line.
 ; Konfiguration über customization groups  
 ;  INDENT1 and INDENT2 are indentation specifications of the form
 ; Bereich nur auf Wortanfang/ende ausweiten, wenn anfang bzw ende in einem      (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, 
 ; Wort liegen (?) -- speed!     specifying how the matching line and all following lines are to be 
 ;     indented, relative to previous lines. NEXT-INDENT specifies how to indent 
 ; User interface     following lines, relative to the matching line.
 ;    
 ; 'forth-word' property muss eindeutig sein!     Even values of SELF-INDENT and NEXT-INDENT correspond to multiples of
 ;     `forth-indent-level'. Odd values get an additional 
 ; imenu support schlauer machen     `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" "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.")
   
   (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   ;; 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 
Line 288  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 391  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 470  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 loudly
Line 513  PARSED-TYPE specifies what kind of text Line 706  PARSED-TYPE specifies what kind of text
 ;; and stuff like that.  ;; and stuff like that.
 (defun forth-change-function (from to len &optional loudly)  (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 loudly)       (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 534  PARSED-TYPE specifies what kind of text Line 734  PARSED-TYPE specifies what kind of text
    "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"     "USER" "VALUE" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"
    "DEFER" "ALIAS")     "DEFER" "ALIAS")
   "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 559  PARSED-TYPE specifies what kind of text Line 761  PARSED-TYPE specifies what kind of text
           (setq index (cons (cons (match-string 1) (point)) index))))            (setq index (cons (cons (match-string 1) (point)) index))))
     index))      index))
   
 (require 'speedbar)  ;; top-level require is executed at byte-compile and load time
 (speedbar-add-supported-extension ".fs")  (eval-and-compile (forth-require 'speedbar))
 (speedbar-add-supported-extension ".fb")  
   ;; 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))
Line 569  PARSED-TYPE specifies what kind of text Line 775  PARSED-TYPE specifies what kind of text
 ;;; 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 774  End:\" construct).") Line 911  End:\" construct).")
   (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 902  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 931  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 958  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: "))
Line 1032  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 1052  exceeds 64 characters." Line 1163  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)
     (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 1070  exceeds 64 characters." Line 1183  exceeds 64 characters."
   (make-local-variable 'forth-use-objects)     (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)    (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))    (setq imenu-create-index-function 'forth-create-index))
   
 ;;;###autoload  ;;;###autoload
Line 1113  Variables controlling syntax hilighting/ Line 1228  Variables controlling syntax hilighting/
     .emacs, or by setting forth-local-words, in source-files' local       .emacs, or by setting forth-local-words, in source-files' local 
     variables lists.      variables lists.
  forth-use-objects   forth-use-objects
     Set this variable to non-nil in your .emacs, or a local variables       Set this variable to non-nil in your .emacs, or in a local variables 
     list, to hilight and recognize the words from the \"Objects\" package       list, to hilight and recognize the words from the \"Objects\" package 
     for object-oriented programming.      for object-oriented programming.
  forth-use-oof   forth-use-oof
Line 1183  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 1232  bell during block file read/write operat Line 1348  bell during block file read/write operat
          (forth-hack-local-variables)           (forth-hack-local-variables)
          (forth-customize-words)           (forth-customize-words)
          (forth-compile-words)           (forth-compile-words)
          (forth-change-function (point-min) (point-max) nil t)))           (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 1757  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 1772  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 1806  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 1854  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)
 ))  ;; ))
   
   (provide 'forth-mode)
   
 ;;; gforth.el ends here  ;;; gforth.el ends here
Removed from v.1.54  
changed lines
  Added in v.1.64

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