--- gforth/gforth.el 2001/06/17 16:13:50 1.51 +++ gforth/gforth.el 2002/01/17 19:26:34 1.57 @@ -1,6 +1,6 @@ ;;; 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. @@ -49,17 +49,67 @@ ;;; Code: - +;; Code ripped from `version.el' for compatability with Emacs versions +;; prior to 19.23. +(unless (boundp 'emacs-major-version) + (defconst emacs-major-version + (progn (string-match "^[0-9]+" emacs-version) + (string-to-int (match-string 0 emacs-version))))) + + +; 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) ;;; +(require 'font-lock) + +(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 "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 -OOP package you're using. After `forth-words' changed, `forth-compile-words' -must be called to make the changes take effect. + +Hilighting of object-oriented Forth code is achieved, by appending either +`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 (MATCHER TYPE HILIGHT . &optional PARSED-TEXT ...) @@ -141,13 +191,15 @@ PARSED-TYPE specifies what kind of text (("true" "false" "c/l" "bl" "cell" "pi" "w/o" "r/o" "r/w") 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]") compile-only (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("is" "what's") immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) - (("" "'") non-immediate (font-lock-keyword-face . 2) + (("" "'" "see") non-immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("[to]") compile-only (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-variable-name-face . 3)) @@ -161,6 +213,7 @@ PARSED-TYPE specifies what kind of text "create-interpret/compile") non-immediate (font-lock-type-face . 2) "[ \t\n]" t name (font-lock-variable-name-face . 3)) + ("\\S-+%" non-immediate (font-lock-type-face . 2)) (("defer" "alias" "create-interpret/compile:") non-immediate (font-lock-type-face . 1) "[ \t\n]" t name (font-lock-function-name-face . 3)) @@ -173,59 +226,58 @@ PARSED-TYPE specifies what kind of text (defvar forth-use-objects nil "*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") -(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 "*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") -(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 "List of Forth words to prepend to `forth-words'. Should be set by a @@ -240,27 +292,76 @@ PARSED-TYPE specifies what kind of text (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. + +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). -; todo: -; +INDENT1 specifies how to indent a word that's located at a line's begin, + following any number of whitespaces. -; Wörter ordentlich hilighten, die nicht auf whitespace beginning ( ..)IF -; Additional `forth-use-objects' or -; `forth-use-oof' could be set to non-nil for automatical adding of those -; word-lists. Using local variable list? -; -; Konfiguration über customization groups -; -; Bereich nur auf Wortanfang/ende ausweiten, wenn anfang bzw ende in einem -; Wort liegen (?) -- speed! -; -; User interface -; -; 'forth-word' property muss eindeutig sein! -; -; imenu support schlauer machen +INDENT2 specifies how to indent words that are not located at a line's begin. -(setq debug-on-error t) +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) + +;(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 @@ -390,7 +491,8 @@ PARSED-TYPE specifies what kind of text ;; Delete all properties, used by Forth mode, from `from' to `to'. (defun forth-delete-properties (from to) (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 ;; expression that matched. (used for identifying branches "a\\|b\\|c...") @@ -469,6 +571,7 @@ PARSED-TYPE specifies what kind of text (setq state (get-text-property (point) 'forth-state)) (setq last-location (point)) (forth-delete-properties (point) to) + (put-text-property (point) to 'fontified t) ;; hilight loop... (while (setq word-descr (forth-next-known-forth-word to)) (when loudly @@ -512,12 +615,19 @@ PARSED-TYPE specifies what kind of text ;; and stuff like that. (defun forth-change-function (from to len &optional loudly) (save-match-data - (forth-save-buffer-state () - (unwind-protect - (progn - (forth-update-properties from to loudly) - (forth-update-show-screen) - (forth-update-warn-long-lines)))))) + (forth-save-buffer-state + () + (unless forth-disable-parser (forth-update-properties from to loudly)) + (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 (byte-compile 'forth-set-word-properties) @@ -528,37 +638,45 @@ PARSED-TYPE specifies what kind of text ;;; 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* ((regexp (car forth-compiled-defining-words)) - (pos (re-search-forward regexp (point-max) t))) - (message "regexp: %s pos:%s" regexp pos) + (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-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* ((defwords - (forth-filter (lambda (word) - (and (eq (nth 1 word) 'definition-starter) - (> (length word) 3))) - forth-words)) - (forth-compiled-defining-words (forth-compile-wordlist defwords)) + (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)))) - (message "index: %s" index) index)) -(speedbar-add-supported-extension ".fs") -(speedbar-add-supported-extension ".fb") +;; top-level require is executed at byte-compile and load time +(require 'speedbar nil t) + +;; this code is executed at load-time only +(when (require 'speedbar nil t) + (speedbar-add-supported-extension ".fs") + (speedbar-add-supported-extension ".fb")) ;; (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)) @@ -566,67 +684,6 @@ PARSED-TYPE specifies what kind of text ;;; 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") (-2 . 0) (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-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 (defun forth-first-word-on-line-p (pos) (save-excursion @@ -644,12 +701,19 @@ End:\" construct).") (let* ((regexp (car forth-compiled-indent-words)) (pos (re-search-forward regexp to t))) (if pos - (if (text-property-not-all (match-beginning 0) (match-end 0) - 'forth-parsed nil) - (forth-next-known-indent-word to) - (let* ((branch (forth-get-regexp-branch)) - (descr (cdr forth-compiled-indent-words)) - (indent (cdr (assoc branch descr)))) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (branch (forth-get-regexp-branch)) + (descr (cdr forth-compiled-indent-words)) + (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)) (nth 0 indent) (nth 1 indent)))) nil))) @@ -697,8 +761,7 @@ End:\" construct).") (defun forth-get-anchor-column () (save-excursion (if (/= 0 (forward-line -1)) 0 - (let ((next-indent) - (self-indent)) + (let ((indent)) (while (not (or (setq indent (forth-get-column-incr 1)) (<= (point) (point-min)))) (forward-line -1)) @@ -861,7 +924,7 @@ done by checking whether the first line (save-restriction (widen) (save-excursion - (beginning-of-buffer) + (goto-char (point-min)) (end-of-line) (>= (current-column) 1024)))) @@ -885,6 +948,7 @@ done by checking whether the first line "Non-nil means to warn about lines that are longer than 64 characters") (defvar forth-screen-marker nil) +(defvar forth-screen-number-string nil) (defun forth-update-show-screen () "If `forth-show-screen' is non-nil, put overlay arrow to start of screen, @@ -914,6 +978,13 @@ exceeds 64 characters." forth-c/l)))) (add-hook 'forth-motion-hooks 'forth-update-warn-long-lines) + +(defvar forth-was-point nil) +(defun forth-check-motion () + "Run `forth-motion-hooks', if `point' changed since last call." + (when (or (eq forth-was-point nil) (/= forth-was-point (point))) + (setq forth-was-point (point)) + (run-hooks 'forth-motion-hooks))) ;;; End block file editing @@ -941,57 +1012,26 @@ exceeds 64 characters." (define-key forth-mode-map "\M-q" 'forth-fill-paragraph) (define-key forth-mode-map "\e." 'forth-find-tag) -;;; hook into motion events (realy ugly!) (dk) -(define-key forth-mode-map "\C-n" 'forth-next-line) -(define-key forth-mode-map "\C-p" 'forth-previous-line) -(define-key forth-mode-map [down] 'forth-next-line) -(define-key forth-mode-map [up] 'forth-previous-line) -(define-key forth-mode-map "\C-f" 'forth-forward-char) -(define-key forth-mode-map "\C-b" 'forth-backward-char) -(define-key forth-mode-map [right] 'forth-forward-char) -(define-key forth-mode-map [left] 'forth-backward-char) -(define-key forth-mode-map "\M-f" 'forth-forward-word) -(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) -(define-key forth-mode-map "\M-v" 'forth-scroll-down) -(define-key forth-mode-map "\C-v" 'forth-scroll-up) -(define-key forth-mode-map [prior] 'forth-scroll-down) -(define-key forth-mode-map [next] 'forth-scroll-up) - -(defun forth-next-line (arg) - (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 "[^ +(require 'info-look nil t) +(when (require 'info-look nil t) + (info-lookup-add-help + :topic 'symbol + :mode 'forth-mode + :regexp "[^ ]+" - :ignore-case t - :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) + :ignore-case t + :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) -(load "etags") +(require 'etags) (defun forth-find-tag (tagname &optional next-p regexp-p) (interactive (find-tag-interactive "Find tag: ")) + (unless (or regexp-p next-p) + (setq tagname (concat "\\(^\\|\\s-\\)\\(" (regexp-quote tagname) + "\\)\\(\\s-\\|$\\)"))) (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 "Syntax table in use in Forth-mode buffers.") @@ -1032,16 +1072,19 @@ exceeds 64 characters." (setq comment-column 40) (make-local-variable 'comment-start-skip) (setq comment-start-skip "\\ ") - (make-local-variable 'comment-indent-hook) - (setq comment-indent-hook 'forth-comment-indent) + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'forth-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments 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-compiled-words) (make-local-variable 'forth-compiled-indent-words) (make-local-variable 'forth-hilight-level) (make-local-variable 'after-change-functions) + (make-local-variable 'post-command-hook) (make-local-variable 'forth-show-screen) (make-local-variable 'forth-screen-marker) (make-local-variable 'forth-warn-long-lines) @@ -1050,6 +1093,9 @@ exceeds 64 characters." (make-local-variable 'forth-use-objects) (setq forth-screen-marker (copy-marker 0)) (add-hook 'after-change-functions 'forth-change-function) + (add-hook 'post-command-hook 'forth-check-motion) + (if (>= emacs-major-version 21) + (add-hook 'fontification-functions 'forth-fontification-function)) (setq imenu-create-index-function 'forth-create-index)) ;;;###autoload @@ -1093,7 +1139,7 @@ Variables controlling syntax hilighting/ .emacs, or by setting forth-local-words, in source-files' local variables lists. 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 for object-oriented programming. forth-use-oof @@ -1212,7 +1258,8 @@ bell during block file read/write operat (forth-hack-local-variables) (forth-customize-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 () "Fill comments (starting with '\'; do not fill code (block style @@ -1737,7 +1784,7 @@ 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-n" 'next-error) -(require 'compile "compile") +(require 'compile) (defvar forth-compile-command "gforth ") ;(defvar forth-compilation-window-percent-height 30) @@ -1789,24 +1836,23 @@ The region is sent terminated by a newli (require 'outline) (defun f-outline-level () - (cond ((looking-at "\\`\\\\") - 0) - ((looking-at "\\\\ SEC") - 0) - ((looking-at "\\\\ \\\\ .*") - 0) - ((looking-at "\\\\ DEFS") - 1) - ((looking-at "\\/\\* ") - 1) - ((looking-at ": .*") - 1) - ((looking-at "\\\\G") - 2) - ((looking-at "[ \t]+\\\\") - 3)) -) - + (cond ((looking-at "\\`\\\\") + 0) + ((looking-at "\\\\ SEC") + 0) + ((looking-at "\\\\ \\\\ .*") + 0) + ((looking-at "\\\\ DEFS") + 1) + ((looking-at "\\/\\* ") + 1) + ((looking-at ": .*") + 1) + ((looking-at "\\\\G") + 2) + ((looking-at "[ \t]+\\\\") + 3))) + (defun fold-f () (interactive) (add-hook 'outline-minor-mode-hook 'hide-body) @@ -1820,9 +1866,7 @@ The region is sent terminated by a newli (define-key outline-minor-mode-map '(shift up) 'hide-sublevels) (define-key outline-minor-mode-map '(shift right) 'show-children) (define-key outline-minor-mode-map '(shift left) 'hide-subtree) - (define-key outline-minor-mode-map '(shift down) 'show-subtree) - -) + (define-key outline-minor-mode-map '(shift down) 'show-subtree)) ;;(define-key global-map '(shift up) 'fold-f) @@ -1842,4 +1886,6 @@ The region is sent terminated by a newli ; (define-key global-map '(shift button3) 'mouse-function-menu) )) +(provide 'forth-mode) + ;;; gforth.el ends here