--- gforth/gforth.el 2002/01/17 19:26:34 1.57 +++ gforth/gforth.el 2002/04/27 14:52:30 1.63 @@ -33,6 +33,7 @@ ;; Changes by David ;; Added a syntax-hilighting engine, rewrote auto-indentation engine. ;; 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 @@ -49,13 +50,65 @@ ;;; Code: +;(setq debug-on-error t) + ;; 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))))) +(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: ; @@ -83,10 +136,40 @@ ; ; Folding neuschreiben (neue Parser-Informationen benutzen) -;;; Hilighting and indentation engine (dk) +;;; Motion-hooking (dk) ;;; -(require 'font-lock) +(defun forth-idle-function () + "Function that is called when Emacs is idle to detect cursor motion +in forth-block-mode buffers (which is mainly used for screen number +display in). Currently ignores forth-mode buffers but that may change +in the future." + (if (eq major-mode 'forth-block-mode) + (forth-check-motion))) + +(defvar forth-idle-function-timer nil + "Timer that runs `forth-idle-function' or nil if no timer installed.") + +(defun forth-install-motion-hook () + "Install the motion-hooking mechanism. Currently uses idle timers +but might be transparently changed in the future." + (unless forth-idle-function-timer + ;; install idle function only once (first time forth-mode is used) + (setq forth-idle-function-timer + (run-with-idle-timer .05 t 'forth-idle-function)))) + +(defvar forth-was-point nil) +(defun forth-check-motion () + "Run `forth-motion-hooks', if `point' changed since last call. This +used to be called via `post-command-hook' but uses idle timers now as +users complaint about lagging performance." + (when (or (eq forth-was-point nil) (/= forth-was-point (point))) + (setq forth-was-point (point)) + (run-hooks 'forth-motion-hooks))) + + +;;; Hilighting and indentation engine (dk) +;;; (defvar forth-disable-parser nil "*Non-nil means to disable on-the-fly parsing of Forth-code. @@ -182,7 +265,8 @@ PARSED-TYPE specifies what kind of text (("[ifdef]" "[ifundef]") immediate (font-lock-keyword-face . 2) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("if" "begin" "ahead" "do" "?do" "+do" "u+do" "-do" "u-do" "for" - "case" "of" "?dup-if" "?dup-0=-if" "then" "until" "repeat" "again" + "case" "of" "?dup-if" "?dup-0=-if" "then" "endif" "until" + "repeat" "again" "loop" "+loop" "-loop" "next" "endcase" "endof" "else" "while" "try" "recover" "endtry" "assert(" "assert0(" "assert1(" "assert2(" "assert3(" ")" "" @@ -306,10 +390,11 @@ TYPE might be omitted. If it's specified 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. +INDENT1 specifies how to indent a word that's located at the beginning + of a line, following any number of whitespaces. -INDENT2 specifies how to indent words that are not located at a line's begin. +INDENT2 specifies how to indent words that are not located at the + beginning of a line. INDENT1 and INDENT2 are indentation specifications of the form (SELF-INDENT . NEXT-INDENT), where SELF-INDENT is a numerical value, @@ -332,9 +417,9 @@ INDENT1 and INDENT2 are indentation spec (0 . 2) (0 . 2) non-immediate) ("\\S-+%$" (0 . 2) (0 . 0) non-immediate) ((";" ";m") (-2 . 0) (0 . -2)) - (("again" "repeat" "then" "endtry" "endcase" "endof" + (("again" "then" "endif" "endtry" "endcase" "endof" "[then]" "[endif]" "[loop]" "[+loop]" "[next]" - "[until]" "[repeat]" "[again]" "loop") + "[until]" "[again]" "loop") (-2 . 0) (0 . -2)) (("end-code" "end-class" "end-interface" "end-class-noname" "end-interface-noname" "end-struct" "class;") @@ -342,7 +427,9 @@ INDENT1 and INDENT2 are indentation spec (("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)) + (("does>") (-1 . 1) (0 . 0)) + (("while" "[while]") (-2 . 4) (0 . 2)) + (("repeat" "[repeat]") (-4 . 0) (0 . -4)) (("\\g") (-2 . 2) (0 . 0)))) (defvar forth-local-indent-words nil @@ -388,11 +475,14 @@ End:\" construct).") ;; Helper function for `forth-compile-word': translate one entry from ;; `forth-words' into the form (regexp regexp-depth word-description) (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)) - (regexp (if (stringp matcher) (concat "\\(" matcher "\\)") - (if (listp matcher) (regexp-opt matcher t) - (error "Invalid matcher (stringp or listp expected `%s'" - matcher)))) + (regexp + (concat "\\(" (cond ((stringp matcher) matcher) + ((listp matcher) (regexp-opt matcher)) + (t (error "Invalid matcher `%s'"))) + "\\)")) (depth (regexp-opt-depth regexp)) (description (cdr word))) (list regexp depth description))) @@ -498,7 +588,8 @@ End:\" construct).") ;; expression that matched. (used for identifying branches "a\\|b\\|c...") (defun forth-get-regexp-branch () (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))) count)) @@ -671,10 +762,10 @@ Used for imenu index generation.") index)) ;; top-level require is executed at byte-compile and load time -(require 'speedbar nil t) +(eval-and-compile (forth-require 'speedbar)) ;; this code is executed at load-time only -(when (require 'speedbar nil t) +(when (memq 'speedbar features) (speedbar-add-supported-extension ".fs") (speedbar-add-supported-extension ".fb")) @@ -820,7 +911,6 @@ Used for imenu index generation.") (forth-newline-remove-trailing) (indent-according-to-mode)) -;;; end hilighting/indentation ;;; Block file encoding/decoding (dk) ;;; @@ -979,13 +1069,6 @@ exceeds 64 characters." (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 @@ -1012,16 +1095,25 @@ exceeds 64 characters." (define-key forth-mode-map "\M-q" 'forth-fill-paragraph) (define-key forth-mode-map "\e." 'forth-find-tag) -;setup for C-h C-i to work -(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 "`" "' ")))) +;; setup for C-h C-i to work +(eval-and-compile (forth-require 'info-look)) +(when (memq 'info-look features) + (defvar forth-info-lookup '(symbol (forth-mode "\\S-+" t + (("(gforth)Word Index")) + "\\S-+"))) + (unless (memq forth-info-lookup info-lookup-alist) + (setq info-lookup-alist (cons forth-info-lookup info-lookup-alist))) + ;; in X-Emacs C-h C-i is by default bound to Info-query + (define-key forth-mode-map "\C-h\C-i" 'info-lookup-symbol)) + + +;; (info-lookup-add-help +;; :topic 'symbol +;; :mode 'forth-mode +;; :regexp "[^ +;; ]+" +;; :ignore-case t +;; :doc-spec '(("(gforth)Name Index" nil "`" "' ")))) (require 'etags) @@ -1052,7 +1144,6 @@ exceeds 64 characters." (setq char (1+ char)))) )) - (defun forth-mode-variables () (set-syntax-table forth-mode-syntax-table) (setq local-abbrev-table forth-mode-abbrev-table) @@ -1084,7 +1175,6 @@ exceeds 64 characters." (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) @@ -1093,8 +1183,7 @@ 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) + (if (and forth-jit-parser (>= emacs-major-version 21)) (add-hook 'fontification-functions 'forth-fontification-function)) (setq imenu-create-index-function 'forth-create-index)) @@ -1209,6 +1298,7 @@ Variables controling documentation searc (use-local-map forth-mode-map) (setq mode-name "Forth") (setq major-mode 'forth-mode) + (forth-install-motion-hook) ;; convert buffer contents from block file format, if necessary (when (forth-detect-block-file-p) (widen) @@ -1799,30 +1889,34 @@ The region is sent terminated by a newli ;;; Forth menu ;;; Mikael Karlsson -(cond ((string-match "XEmacs\\|Lucid" emacs-version) - (require 'func-menu) +;; (dk) code commented out due to complaints of XEmacs users. After +;; all, there's imenu/speedbar, which uses much smarter scanning +;; rules. + +;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) +;; (require 'func-menu) + +;; (defconst fume-function-name-regexp-forth +;; "^\\(:\\)[ \t]+\\([^ \t]*\\)" +;; "Expression to get word definitions in Forth.") + +;; (setq fume-function-name-regexp-alist +;; (append '((forth-mode . fume-function-name-regexp-forth) +;; ) fume-function-name-regexp-alist)) + +;; ;; Find next forth word in the buffer +;; (defun fume-find-next-forth-function-name (buffer) +;; "Searches for the next forth word in BUFFER." +;; (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)))) - (defconst fume-function-name-regexp-forth - "^\\(:\\)[ \t]+\\([^ \t]*\\)" - "Expression to get word definitions in Forth.") - - (setq fume-function-name-regexp-alist - (append '((forth-mode . fume-function-name-regexp-forth) - ) fume-function-name-regexp-alist)) - - ;; Find next forth word in the buffer - (defun fume-find-next-forth-function-name (buffer) - "Searches for the next forth word in BUFFER." - (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 +;; (append '((forth-mode . fume-find-next-forth-function-name)))) - (setq fume-find-function-name-method-alist - (append '((forth-mode . fume-find-next-forth-function-name)))) - - )) +;; )) ;;; End Forth menu ;;; File folding of forth-files @@ -1833,40 +1927,44 @@ The region is sent terminated by a newli ;;; Works most of the times but loses sync with the cursor occasionally ;;; 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?? + +;; (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))) +;; (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))) -(defun fold-f () - (interactive) - (add-hook 'outline-minor-mode-hook 'hide-body) - - ; outline mode header start, i.e. find word definitions -;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") - (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) - (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)) +;; (defun fold-f () +;; (interactive) +;; (add-hook 'outline-minor-mode-hook 'hide-body) + +;; ; outline mode header start, i.e. find word definitions +;; ;;; (setq outline-regexp "^\\(:\\)[ \t]+\\([^ \t]*\\)") +;; (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) +;; (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 global-map '(shift up) 'fold-f) @@ -1878,13 +1976,13 @@ The region is sent terminated by a newli ;;; for all of the recognized languages. Scanning the buffer takes some time, ;;; but not much. ;;; -(cond ((string-match "XEmacs\\|Lucid" emacs-version) - (require 'func-menu) -;; (define-key global-map 'f8 'function-menu) - (add-hook 'find-fible-hooks 'fume-add-menubar-entry) -; (define-key global-map "\C-cg" 'fume-prompt-function-goto) -; (define-key global-map '(shift button3) 'mouse-function-menu) -)) +;; (cond ((string-match "XEmacs\\|Lucid" emacs-version) +;; (require 'func-menu) +;; ;; (define-key global-map 'f8 'function-menu) +;; (add-hook 'find-fible-hooks 'fume-add-menubar-entry) +;; ; (define-key global-map "\C-cg" 'fume-prompt-function-goto) +;; ; (define-key global-map '(shift button3) 'mouse-function-menu) +;; )) (provide 'forth-mode)