--- gforth/gforth.el 2001/06/17 16:13:50 1.51 +++ gforth/gforth.el 2001/12/15 22:44:52 1.55 @@ -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,40 @@ ;;; 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))))) + ;;; 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 "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,7 +164,9 @@ 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:") 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)) @@ -161,6 +186,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)) @@ -214,7 +240,7 @@ PARSED-TYPE specifies what kind of text "[ \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) + (("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) @@ -244,23 +270,30 @@ PARSED-TYPE specifies what kind of text ; todo: ; -; 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? +; 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 +; 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 +; 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) -(setq debug-on-error t) +;(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 +423,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 +503,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 +547,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 +570,41 @@ 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.") + + (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") +(unwind-protect + (progn + (require 'speedbar) + (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)) @@ -569,12 +615,17 @@ PARSED-TYPE specifies what kind of text (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 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. @@ -593,19 +644,22 @@ INDENT1 and INDENT2 are indentation spec 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") + '((("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)) - (("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;") + (("again" "repeat" "then" "endtry" "endcase" "endof" + "[then]" "[endif]" "[loop]" "[+loop]" "[next]" + "[until]" "[repeat]" "[again]" "loop") (-2 . 0) (0 . -2)) - (("protected" "public" "how:") (-1 . 1) (0 . 0)) + (("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)) @@ -644,12 +698,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 +758,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 +921,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)))) @@ -914,6 +974,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,41 +1008,6 @@ 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 @@ -990,8 +1022,11 @@ exceeds 64 characters." (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.") @@ -1037,11 +1072,14 @@ exceeds 64 characters." (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 +1088,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 +1134,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 +1253,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